Hallo zusammen!
Ich habe ein Problem mit einem Makro, welches ich schreiben will..
Kurze Zusammenfassung der Funktion des Makros:
Ich gebe im Sheet(Ergebnis_Blatt) in Zeile 3 Spalte C einen Wert ein, der nur einmal vorkommt. Dieser Wert wird in Sheet(Rohdaten_Kunde) in Zeile 6 gesucht. Zu dem gesuchten Wert gehören immer bis zu 8000 Messungen die in der gleichen Spalte stehen. Die Messwerte sollen dann aus(Rohdaten_Kunde) herauskopiert und in (Ergebnis_Blatt) in Zeile 11 Spalte C eingefügt werden. Hinzu kommt noch das Problem, dass die Messwerte evtl. umgerechnet werden müssen, beispielsweise von kg in Tonnen. Der Umrechnungsfaktor ändert sich aber für die Messwerte einer Spalte NICHT.
Der nächste gesuchte Wert wird dann in Zeile 3 Spalte D eingegeben und das Prozedere wird wiederholt.
Am besten sollen die Spalten nur bis zur letzten beschriebenen Zelle kopiert werden, um unnötigen Datenverbrauch zu vermeiden.
Was bekomme ich momentan hin:
1. Ich finde die Spalte in Rohdaten_Kunde
2. Die Spalte des gefundenen Wertes mit Offset zu kopieren: Range(finden.offst(4,0,finden.offset(10000,0).copy
3. die gesuchte Spalte einzufügen --> hier fangen die Probleme an..
Wo ich Probleme habe:
1. Eine Spalte bis zur letzten beschriebenen Zelle anzusprechen range("B11:column.count.end.xlup")? Keine Ahnung wie die Syntax ist..
2. Die Messdaten in die Spalte einzufügen und dann für den nächsten Block an Messwerten des nächsten gesuchten Wertes eine Spalte weiter nach rechts zu springen
3. Eine Spalte von Messwerten mit einem Faktor zu multiplizieren.
Mein Code bisher:
Sub KKS_Und_Spalte_Kopieren()
TestZeile = 1
a = 3
n = 1
For i = 3 To Worksheets("Ergebnis_Blatt").Cells(TestZeile, Columns.Count).End(xlToLeft).Column
Worksheets("Rohdaten_Kunde").Activate
Set finden = Range("B1:HB1").Find(What:=(Worksheets("Ergebnis_Blatt").Cells(5, a).Value))
If Worksheets("Ergebnis_Blatt").Cells(5, a).Value = "" Then
MsgBox "Sie haben nichts eingetragen!"
Else
finden.Copy Destination:=Worksheets("Ergebnis_Blatt").Cells(6, a)
Set Bereich = ActiveSheet.Range("C11")
finden.Select
Range(finden.Offset(4, 0), finden.Offset(10000, 0)).Copy Destination:=Worksheets("Ergebnis_Blatt").Cells(6, a)
End If
a = a + 1
n = n + 1
Next
End Sub
über eure Hilfe wäre ich sehr, sehr dankbar
viele Güße
euer verlorener Praktikant, Lars
|