VBA - Excel Makro das Vergleicht und einen Wert ko
05.03.2013 13:03:37
fedx
ich bin hier neu und auch ein VBA neuling. Ich habe das Problem das ich in einem Tabellen Blatt Sachen suchen und kopieren möchte.
Ich hab schon ein Makro gefunden das funktioniert. Das Problem ist jetzt das dieses Makro für denke ich kurze Zeichenfolgen geschrieben wurde. Das Problem für mich ist nun das ich das Makro dahingehend ändern möchte das es Felder mit Text und Sonderzeichen kopiert. Bis jetzt kommt immer Laufzeitfehler 13 Typen unverträglich.
Anbei das Makro:
Option Explicit
'
' Die Reihenfolge der Spalte C ist vorgegeben.
' Das Makro soll jetzt Spalte C von oben nach unten mit Spalte A
' vergleichen und sobald der Bezeichner gleich ist, soll der
' entsprechende Messwert von B nach D kopiert werden.
' Falls in Spalte C ein Bezeichner in Spalte A nicht gefunden wird,
' soll das Feld in der Zeile in Spalte E markiert werden.
' In Spalte C können auch leere Felder bestehen, diese sollen dann
' vom Makro einfach übersprungen werden.
'
Public Sub Zuordnen()
Dim WkSh As Worksheet ' das zu bearbeitende Tabellenblatt
Dim lZeile As Long ' For/Next Schleifen-Index - hier die fortlaufende Zeile
Dim rZelle As Range ' die Zelle mit dem gefundenen Suchbegriff
Set WkSh = ThisWorkbook.Worksheets("Tabelle1") ' den Tabellenblattnamen ggf. anpassen!
With WkSh.Columns(1) ' in dieser Spalte 1 = A suchen
' alle Zeilen ab Zeile 1 bis zum Ende, gemäß Spalte 3 = C abarbeiten
For lZeile = 1 To WkSh.Cells(WkSh.Rows.Count, 3).End(xlUp).Row
If Trim$(WkSh.Range("C" & lZeile).Value) "" Then ' ist Spate C nicht leer?
' den Inhalt aus Spalte C in Spalte A suchen
Set rZelle = .Find(What:=WkSh.Range("C" & lZeile).Value, LookAt:=xlWhole, LookIn:=xlValues)
If Not rZelle Is Nothing Then ' der Wert wurde gefunden!
' den Inhalt aus Spalte B nach Spalte D kopieren
WkSh.Range("D" & lZeile).Value = WkSh.Range("B" & rZelle.Row).Value
' evtl. Markierungen in Spalte E zurücknehmen
WkSh.Range("E" & lZeile).Interior.ColorIndex = xlNone
Else ' der Inhalt aus Spalte C wurde in Spalte A NICHT gefunden
' die Spalte E rot markieren
WkSh.Range("E" & lZeile).Interior.ColorIndex = 3
End If
Else ' Spalte C ist leer
' evtl. Markierungen in Spalte E zurücknehmen
WkSh.Range("E" & lZeile).Interior.ColorIndex = xlNone
End If
Next lZeile
End With
End Sub
Wäre für jede hilfe sehr dankbar!