AW: zelleninhalte suchen und tauschen
25.11.2014 01:54:25
fcs
Hallo Christian,
hier mein Vorschlag für das Suchen-/Ersetzen-Makro für die Schaltfläche im Userform.
Gruß
Franz
Private Sub CommandButton1_Click()
Dim wks, intSheet
Dim arrwks1() As Worksheet, arrwks2() As Worksheet
Dim arrZeile1() As Long, arrZeile2() As Long
Dim int1 As Integer, int2 As Integer
Dim varTB_1, varTB_2, varTB_3
Dim arrData, Zeile As Long, ZeileL As Long
'Eingaben in Textboxen prüfen und Werte in Variablen übernehmen
With Me.TextBox1
If .Value = "" Then
MsgBox "Bitte erst Maschinen-Nr. eingeben!"
Exit Sub
Else
varTB_1 = IIf(IsNumeric(.Value), Val(.Value), .Value)
End If
End With
With Me.TextBox2
If .Value = "" Then
MsgBox "Bitte erst Nr. für Auftrag 1 eingeben!"
Exit Sub
Else
varTB_2 = IIf(IsNumeric(.Value), Val(.Value), .Value)
End If
End With
With Me.TextBox3
If .Value = "" Then
MsgBox "Bitte erst Nr. für Auftrag 2 eingeben!"
Exit Sub
Else
varTB_3 = IIf(IsNumeric(.Value), Val(.Value), .Value)
End If
End With
'Werte in Tabelle2 bis Tabelle8 suchen
For intSheet = 2 To 10 Step 2
Set wks = ActiveWorkbook.Sheets("Tabelle" & Format(intSheet, "0"))
With wks
'letzte Zeile mit daten in Spalte C
ZeileL = .Cells(.Rows.Count, 3).End(xlUp).Row
'Daten aus Spalten B:C in Array einlesen
arrData = .Range(.Cells(1, 2), .Cells(ZeileL, 3))
'Werte vergleichen und Treffer-Blatt/Zeile merken
For Zeile = 3 To ZeileL
If arrData(Zeile, 1) = varTB_1 Then 'Maschine vergleichen
If arrData(Zeile, 2) = varTB_2 Then 'Auftrag 1 vergleichen
int1 = int1 + 1
ReDim Preserve arrwks1(1 To int1), arrZeile1(1 To int1)
arrZeile1(int1) = Zeile
Set arrwks1(int1) = wks
End If
If arrData(Zeile, 2) = varTB_3 Then 'Auftrag 2 vergleichen
int2 = int2 + 1
ReDim Preserve arrwks2(1 To int2), arrZeile2(1 To int2)
arrZeile2(int2) = Zeile
Set arrwks2(int2) = wks
End If
End If
Next Zeile
End With
Next intSheet
If int1 = 0 Or int2 = 0 Then
If int1 = 0 Then
MsgBox "Auftrag " & varTB_2 & " zu Maschine " & varTB_1 & " nicht gefunden!"
End If
If int2 = 0 Then
MsgBox "Auftrag " & varTB_3 & " zu Maschine " & varTB_1 & " nicht gefunden!"
End If
Else
'Werte in gefundenen Zellen ersetzen
'Auftrag 1 durch Auftrag 2 ersetzen
For Zeile = 1 To int1
arrwks1(Zeile).Cells(arrZeile1(Zeile), 3).Value = varTB_3
Next
'Auftrag 2 durch Auftrag 1 ersetzen
For Zeile = 1 To int2
arrwks2(Zeile).Cells(arrZeile2(Zeile), 3).Value = varTB_2
Next
' Unload Me 'Userform schliessen
End If
'Variablen zurücksetzen
Erase arrData, arrwks1, arrwks2, arrZeile1, arrZeile2
Set wks = Nothing
End Sub