Zeilen und Spalten Abfrage
16.07.2014 07:47:06
Bon
ich bastle gerade an einem Code:
Ich habe zwei Tabellen.
Ich möchte, dass die Inhalte der Quelldatei in die Zieldatei eingetragen werden, wenn der Text in Zeile 4 bzw. 10 und Spalte A beider Tabellen übereinstimmt.
Hier ein Beispiel:
Tabellenblatt "Quelldatei"
A B C D
4 Apfel Pfirsich Orangen
5 Saft 5 3 1
6 Schorle 1 0
7 Bier 2 3 1
8
Tabellenblatt" Zieldatei"
A B C D
10 Apfel Orangen Pfirsich
11 Saft 5 1 3
12 Bier 2 3 1
13
14
Existiert ein Begriff in Spalte B in der Quelldatei nicht, dann soll es leer bleiben.
Den Code den ich bisher gefunden habe bezieht sich auf genaue Spaltenangaben.
Ich möchte, dass Excel in Zeile 4 (von A bis Q) der Quelldatei geht und mit Zeile 10 der Zieldatei vergleicht; wenn dann auch die Begriffe in Spalte A überein stimmen soll er die Zahl hineinschreiben.Die relevanten Zahlen in meiner Quelldatei sind von A1:Q37.
Sub Uebertragen_Frucht_1()
'Zieltabelle, Quelltabelle
Uebertragen_Frucht "Tabelle1", "Tabelle2"
End Sub
Function Uebertragen_Frucht(Ziel As String, Quelle As String)
Dim colDummy As Collection
Dim colZeilen As New Collection
Dim i As Long
Dim k As Long
Dim colQuelle As Long
Dim colZiel As Long
Dim strSearch As String
Dim varDummy As Variant
Dim wsZiel As Worksheet
Dim wsQuelle As Worksheet
Dim dtmBeginn As Date
On Error Resume Next
dtmBeginn = Now
Set wsZiel = Worksheets(Ziel)
Set wsQuelle = Worksheets(Quelle)
With wsQuelle 'Quelldatei
For i = 5 To 50
strSearch = CStr(.Cells(i, 1))
If strSearch "" Then
Set colDummy = New Collection
colZeilen.Add colDummy, "X-" & strSearch
colZeilen("X-" & strSearch).Add i, "Quellzeile"
End If
Next
'Zielspalte ermitteln
strSearch = wsQuelle.Range("D4").Text 'gesuchte Frucht in Quelldatei
Set varDummy = wsZiel.Rows(10).Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole)
If varDummy Is Nothing Then
MsgBox "Frucht """ & strSearch & """ nicht in Zeile 4 der Zieltabelle gefunden!"
GoTo Beenden
Else
colZiel = varDummy.Column
End If
End With
With wsZiel
For i = 5 To 50
strSearch = CStr(.Cells(i, 1))
If strSearch "" Then
colZeilen("X-" & strSearch).Add i, "Zielzeile"
End If
Next
'Quellspalte ermitteln
strSearch = wsZiel.Range("D4").Text
Set varDummy = wsQuelle.Rows(4).Find(what:=strSearch, LookIn:=xlValues, lookat:=xlWhole)
If varDummy Is Nothing Then
MsgBox "Frucht """ & strSearch & """ nicht in Zeile 4 der Quelltabelle gefunden!"
GoTo Beenden
Else
colQuelle = varDummy.Column
End If
End With
With wsZiel 'Zieldatenblatt
Application.ScreenUpdating = False
For Each varDummy In colZeilen
i = varDummy("Zielzeile")
k = varDummy("Quellzeile")
.Cells(i, colZiel).Value = wsQuelle.Cells(k, colQuelle).Value
Next
End With
Beenden:
Application.ScreenUpdating = True
End Function