Ich bin ganz neu in VBA und Makros. Ich bin ziemlich anständig gestolpert, aber ich bin auf dieses Problem gestoßen, und ich bin nicht sicher, wie ich den Code optimieren soll.
Der Benutzer muss in der Lage sein, einen Wert (eine Zahl) einzugeben, um das gesamte Arbeitsblatt zu durchsuchen. Ist dieser gefunden, kopieren Sie ihn und fügen ihn in die nächste leere Zelle in Spalte B auf einem anderen Blatt im selben Arbeitsblatt ein.
Es wird immer weniger, wo ich es haben will.
Jede Hilfe wäre dankbar.
Sub Reference_Lookup_Paste()
' Written by Barrie Davidson
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer
Application.ScreenUpdating = False
On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter the Reference Number.")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If ActiveCell.Value = datatoFind Then Call Reference_Move
On Error Resume Next
Next counter
If ActiveCell.Value <> datatoFind Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub
Sub Reference_Move()
Selection.Copy
Sheets("Service-Warranty").Select
Dim r1 As Range, r2 As Range
Set r1 = Intersect(Range("B:B"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.count, "B").End(xlUp).Offset(1, 0)
If r1 Is Nothing Then
r2.Select
Else
r1(1).Select
End If
ActiveSheet.Paste
End Sub
Hier ist der Aufruf von If ActiveCell.Value = datatoFind
Sub Reference_Move()
Selection.Copy
Sheets("Service-Warranty").Select
Dim r1 As Range, r2 As Range
Set r1 = Intersect(Range("B:B"), Cells.SpecialCells(xlCellTypeBlanks))
Set r2 = Cells(Rows.count, "B").End(xlUp).Offset(1, 0)
If r1 Is Nothing Then
r2.Select
Else
r1(1).Select
End If
ActiveSheet.Paste
End Sub
Update: Jetzt findet es den Wert und fügt ihn in die richtige Spalte ein, fügt aber statt nur einer Zelle 4 Zellen nach unten ein. Wenn die Daten nicht gefunden werden, wird trotzdem eingefügt, was auch immer sich in der Zwischenablage befindet.
Sub Reference_Lookup_Paste()
' Written by Barrie Davidson
Dim datatoFind
Dim sheetCount As Integer
Dim counter As Integer
Dim currentSheet As Integer
Application.ScreenUpdating = False
On Error Resume Next
currentSheet = ActiveSheet.Index
datatoFind = InputBox("Please enter the Reference Number.")
If datatoFind = "" Then Exit Sub
sheetCount = ActiveWorkbook.Sheets.count
If IsError(CDbl(datatoFind)) = False Then datatoFind = CDbl(datatoFind)
For counter = 1 To sheetCount
Sheets(counter).Activate
Cells.Find(What:=datatoFind, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False).Activate
If ActiveCell.Value = datatoFind Then Selection.Copy
Sheets("Service-Warranty").Select
Range("B1").End(xlDown).Offset(1, 0).Select
ActiveSheet.Paste
Next counter
If ActiveCell.Value <> datatoFind Then
MsgBox ("Value not found")
Sheets(currentSheet).Activate
End If
End Sub
quelle
Antworten:
Sie müssen davon Abstand nehmen,
.Select
Zellen, Zellbereiche und sogar Arbeitsblätter als Referenzierungsmethode zu verwenden. Jedes kann direkt auf seine eigene Weise referenziert werden. Weitere Informationen finden Sie unter Vermeiden der Verwendung von Select in Excel VBA-Makros von dieser anderen Site.Hier ist ein Code, der direkte Verweise verwendet, um die von Ihnen festgelegten Ziele zu erreichen.
Ich habe VBAs verwendet
Application.Countif
, um alle ausgefüllten Zellen in jedem Arbeitsblatt gleichzeitig.CurrentRegion
zu betrachten. Das Arbeitsblatt.Cells(1, 1).CurrentRegion
ist die ununterbrochene Dateninsel, die bei A1 beginnt und nach rechts und unten fortgesetzt wird, bis eine vollständig leere Zeile oder Spalte gefunden wird. Sie können dies demonstrieren, indem Sie A1 auswählen und auf Ctrl+ tippen A.quelle
sMsg = sMsg & .Parent.Name & Chr(10)
Linie geschehen. Wollen Sie damit sagen, dass es nicht so ist?