Hallo zusammen,
ich habe 2 Workbooks und möchte im ersten Workbook den eine Spalte (Status) updaten. Die Info, ob der Status auf erledigt gesetzt werden kann, kommt aus einem anderen Workbook.
Workbook 1:
Nachname |
Vorname |
Alter |
Status (soll geupdated werden) |
Meier |
Hans |
75 |
i.A. |
Grüner |
Franz |
60 |
i.A. |
Jobs |
Steve |
40 |
i.A. |
Zuckerberg |
Mark |
35 |
i.A. |
Gates |
Bill |
20 |
i.A. |
Workbook 2:
Nachname |
Vorname |
Alter |
Status |
Meier |
Hans |
75 |
erl. |
Grüner |
Franz |
60 |
erl. |
Buffett |
Warren |
80 |
erl. |
Zuckerberg |
Mark |
35 |
erl. |
Kostolani |
Yuri |
80 |
erl. |
Das heist mein Makro muss erkennen, ob es sich um "Meier Hans" im WB2 handelt und ob dort der Status "erledigt" hinterlegt ist. Wenn das Match stimmt soll automatisch der Status in WB1 auf "erledigt" gesetzt werden.
Ich habe mal mit Range.Find rumprobiert und finde zumindest die Zuordnungen von WB1 zu WB2 über die Namen... aber mit der Status schreiben habe ich keine Ahnung.
Public Sub Test()
Const FILE_PATH = "C:\Users\***\Desktop\vba\wb2.xlsm"
Const FILE_PATH_STATUS = "C:\Users\***\Desktop\vba\wb1.xlsm"
Dim objWorkbook As Workbook
Dim objCell As Range
Dim SrcRange As Range
Dim find_array() As String
Dim loop_st As Variant
Workbooks("wb1.xlsm").Activate
' MsgBox (ActiveWorkbook.Name)
find_array = GetArray(Worksheets("Status_Sheet").Range("A2:A2000"))
Set objWorkbook = Workbooks.Open(Filename:=FILE_PATH, _
UpdateLinks:=0, ReadOnly:=True)
Workbooks("wb2.xlsm").Activate
' MsgBox (ActiveWorkbook.Name)
For Each loop_st In find_array
Set objCell = ActiveWorkbook.Worksheets("WB2_Sheet"). _
Range("A2:A2000").Find(What:=loop_st)
If IIf(objCell Is Nothing, "", objCell) = "" Then
Else
MsgBox objCell.Value
MsgBox objCell.Address
End If
Next loop_st
' Call objWorkbook.Close(SaveChanges:=True)
Set objCell = Nothing
Set objWorkbook = Nothing
End Sub
---------------------------------------------------------------------
Public Function GetArray(xlRange As Range) As String()
Dim strArray() As String
Dim iCounter As Integer
Dim intCount As Integer
Dim xlCell As Range
iCounter = 0
intCount = xlRange.Cells.Count
ReDim strArray(0 To intCount - 1)
For Each xlCell In xlRange
strArray(iCounter) = xlCell.Value
iCounter = iCounter + 1
Next
GetArray = strArray
End Function
Danke für eure Hilfe!
|