VBA--Zellen finden/vergleichen/kopieren

Sheets("179").Select Range("B255").End(xlUp).Offset(1, 0).Select ActiveCell.FormulaR1C1 = "=TRIM(LEFT('tägliche Statistik'!R12C6,FIND(""/"",'tägliche Statistik' _ !R12C6)-1))" Range("C255").End(xlUp).Offset(1, 0).Select ActiveCell.FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(MID('tägliche Statistik'!R12C6,FIND(""/"",'tä _ gliche Statistik'!R12C6)+1,FIND(""("",'tägliche Statistik'!R12C6)-FIND(""/"",'tägliche Statistik'!R12C6)-1),"" "",""""), CHAR(160),"""")" Range("D255").End(xlUp).Offset(1, 0).Select ActiveCell.FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(MID('tägliche Statistik'!R12C6,FIND(""("",'tä _ gliche Statistik'!R12C6)+1,FIND("")"",'tägliche Statistik'!R12C6)-FIND(""("",'tägliche Statistik'!R12C6)-1),"" "",""""), CHAR(160),"""")"

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Christian,
das folgende Makro sucht die Einträge in Zeile 2 in der täglichen statistik schreibt die entsprechende Formel/Zahlenwerte in die nächste freie Zeile.
Gruß
Franz


Sub aaTest()
Dim wks179 As Worksheet, lngZeile179 As Long, varSuch As Variant
Dim lngSpalte As Long
Dim wksTagStat As Worksheet
Dim strZelleRC As String, rngZelle As Range
Set wks179 = Worksheets("179")
Set wksTagStat = Worksheets("tägliche Statistik")
With wks179
'nächste leere Datenzeile in Spalte B
lngZeile179 = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
'Werte in Zeile 2 abarbeiten
For lngSpalte = 2 To .Cells(2, .Columns.Count).End(xlToLeft).Column - 3 Step 3
varSuch = .Cells(2, lngSpalte)
'Suchwert in täglicher Statistik suchen
Set rngZelle = wksTagStat.Cells.Find(What:=varSuch, LookIn:=xlValues, lookat:=xlWhole)
If rngZelle Is Nothing Then
MsgBox varSuch & " in Blatt " & wksTagStat.Name & " nicht gefunden!"
'Nullwerte eintragen
.Cells(lngZeile179, lngSpalte).Value = 0
.Cells(lngZeile179, lngSpalte + 1).Value = 0
.Cells(lngZeile179, lngSpalte + 2).Value = 0
Else
'Zelle mit Wert setzen
Set rngZelle = rngZelle.Offset(1, 0)
'String der Zelladresse
strZelleRC = "'" & wksTagStat.Name & "'!" & rngZelle.Address(ReferenceStyle:=xlR1C1)
'Formel Spalte 1 ( B, E usw.)
.Cells(lngZeile179, lngSpalte).FormulaR1C1 = "=TRIM(LEFT(" & strZelleRC _
& ",FIND(""/""," & strZelleRC & ")-1))"
'Formel Spalte 2 ( C, F usw.)
.Cells(lngZeile179, lngSpalte + 1).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(MID(" _
& strZelleRC & ",FIND(""/""," & strZelleRC & ")+1,FIND(""(""," & strZelleRC _
& ")-FIND(""/""," & strZelleRC & ")-1),"" "",""""), CHAR(160),"""")"
'Formel Spalte 3 ( D, G usw.)
.Cells(lngZeile179, lngSpalte + 2).FormulaR1C1 = "=SUBSTITUTE(SUBSTITUTE(MID(" _
& strZelleRC & ",FIND(""(""," & strZelleRC & ")+1,FIND("")""," & strZelleRC _
& ")-FIND(""(""," & strZelleRC & ")-1),"" "",""""), CHAR(160),"""")"
'Formeln durch Zahlenwerte erstzen
.Cells(lngZeile179, lngSpalte).Value = CDbl(.Cells(lngZeile179, lngSpalte))
.Cells(lngZeile179, lngSpalte + 1).Value = CDbl(.Cells(lngZeile179, lngSpalte + 1))
.Cells(lngZeile179, lngSpalte + 2).Value = CDbl(.Cells(lngZeile179, lngSpalte + 2))
End If
Next
End With
End Sub

Beliebteste Forumthreads (12 Monate)

VBA--Zellen finden/vergleichen/kopieren

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

350 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA--Zellen finden/vergleichen/kopieren

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

350 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread