Code verbessern

Bild

Betrifft: Code verbessern
von: Andi
Geschrieben am: 03.07.2015 19:15:11

Hallo,
habe einen VBA Code den ich der nicht ganz Funktioniert.
Hier geht es darum das ich zwei Tabellen habe, und in der einen Tabelle2 möchte ich die Daten durch Suchkriterium (wie Sverweis oder Index) in die erste Tabelle ausgeben.
Da die Daten in der Tabelle1 importiert werden und die Zellbezüge mit Sverweis sich ändern je nach importierten Zeilenanzahl muss ich das über VBA machen.
Wie kann mann das Suchkriterium variabel Programmieren je nachdem wieviel Zeilen importiert wurden.

Public Sub WieSverweis()
Dim MyDic As Object
Dim Matrix As Variant
Dim Suchkriterium As Variant
Dim L As Long
Dim Ausgabe As Variant
Dim letztezeile As Integer
Set MyDic = CreateObject("Scripting.Dictionary")
Matrix = Sheets("Tabelle1").Range("A:Z")
letztezeile = Worksheets("Tabelle2").Cells(Rows.Count, 6).End(xlUp).Row
Suchkriterium = Sheets("Tabelle2").Range("F6" & letztezeile) 'geht noch nicht
For L = 1 To UBound(Matrix)
    MyDic(Matrix(L, 1)) = Array(Matrix(L, 2), Matrix(L, 3), Matrix(L, 4), Matrix(L, 5), Matrix(  _
_
L, 6), Matrix(L, 7), Matrix(L, 8))
    '_________________________Spaltenindex2_Spaltenindex3_Spaltenindex4_Spaltenindex5
Next
ReDim Ausgabe(1 To UBound(Suchkriterium), 1 To 8)
On Error Resume Next
For L = 1 To UBound(Suchkriterium)
    Ausgabe(L, 2) = Suchkriterium(L, 2)
    Ausgabe(L, 1) = MyDic(Suchkriterium(L, 1))(0)
    Ausgabe(L, 2) = MyDic(Suchkriterium(L, 1))(1)
    Ausgabe(L, 3) = MyDic(Suchkriterium(L, 1))(2)
    Ausgabe(L, 4) = MyDic(Suchkriterium(L, 1))(3)
    Ausgabe(L, 5) = MyDic(Suchkriterium(L, 1))(4)
    Ausgabe(L, 6) = MyDic(Suchkriterium(L, 1))(5)
    Ausgabe(L, 7) = MyDic(Suchkriterium(L, 1))(6)
    Ausgabe(L, 8) = MyDic(Suchkriterium(L, 1))(7)
    Ausgabe(L, 9) = MyDic(Suchkriterium(L, 1))(8)
    Ausgabe(L, 10) = MyDic(Suchkriterium(L, 1))(9)
Next
Sheets("Ziel").Range("G6").Resize(UBound(Suchkriterium), 8) = Ausgabe 'Hier werden die  _
Ergebnisse ausgegeben.Anpassen.
End Sub

Bild

Betrifft: AW: Code verbessern
von: Taro
Geschrieben am: 03.07.2015 19:23:53
Hallo,
kannst du deine Problemstellung nochmal erklären? Da werde ich noch nicht ganz schlau draus.
Ich vermute fast da gibt es einen einfacheren Weg.

Bild

Betrifft: AW: Code verbessern
von: Andi
Geschrieben am: 03.07.2015 19:47:00
Hallo,
es sind Zwei Tabellen.
In die Tabelle 1 werden Daten importiert.
In der Tabelle2 sind vorhandene Daten die ich in Tabelle1 ab Spalte F6 zuordnen will.
Die Zeilen können dabei unterschiedlich lang sein.
Die Kriterien sind in Tabelle1 in Spalte G6 und diese möchte ich aus der Tabelle2 Spalte A-H in Tabelle1 ab Spalte G-M ausgeben!
Im Prinzip wie SVerweis nur in VBA!
Danke in voraus!!
Andi

Bild

Betrifft: so vielleicht?
von: robert
Geschrieben am: 03.07.2015 19:50:40
Suchkriterium = Sheets("Tabelle2").Range("F6:F" & letztezeile)
Gruß
robert

Bild

Betrifft: AW: so vielleicht?
von: Andi
Geschrieben am: 03.07.2015 20:00:35
Hallo,
habe ich auch probiert ging nicht jetzt Gehts!!
Super
noch eine Kleinigkeit währe da noch!
In Spalte O habe ich Datumswerte die mit der Spalte H (steht eine 1 oder eine 2) auf Jahre hochgerechenet weden sollen.
Tabelle1.Cells(L, 15).Value = DateSerial(Year(Tabelle1.Cells(L, 15)) + Tabelle1.Cells(L, 8))
hab da auch gerade mein Problem damit
Danke nochnals!!

Bild

Betrifft: AW: so vielleicht?
von: Andi
Geschrieben am: 03.07.2015 21:23:57
Hallo,
Da Zellen in Spalten nicht gefüllt sind sollen sie leer bleiben ansonsten soll er mir die Zahl in Spalte H mit Spalte H berechnen.
klappt aber nicht!!
If Sheets("Ziel").Range("O6:O" & letztezeile).Value Or Sheets("Ziel").Range("H6:H" & letztezeile).Value <> "" Then
Sheets("Ziel").Range("O6:O" & letztezeile).Value = Sheets("Ziel").Range("H6:H" & letztezeile).Value + Sheets("Ziel").Range("O6:O" & letztezeile).Value

End If

Bild

Betrifft: AW: so vielleicht?
von: Andi
Geschrieben am: 03.07.2015 21:24:27
Hallo,
Da Zellen in Spalten nicht gefüllt sind sollen sie leer bleiben ansonsten soll er mir die Zahl in Spalte H mit Spalte H berechnen.
klappt aber nicht!!
If Sheets("Ziel").Range("O6:O" & letztezeile).Value Or Sheets("Ziel").Range("H6:H" & letztezeile).Value <> "" Then
Sheets("Ziel").Range("O6:O" & letztezeile).Value = Sheets("Ziel").Range("H6:H" & letztezeile).Value + Sheets("Ziel").Range("O6:O" & letztezeile).Value

End If

Bild

Betrifft: AW: so vielleicht?
von: Werner
Geschrieben am: 04.07.2015 08:48:24
Hallo Andi,
mit deinem Code prüfst du ja einen ganzen Bereich ob er ungleich leer ist, O6:0letztezeile. Das wird ja wohl immer der Fall sein, da du ja im Then Bereich Daten addierst, also nehme ich mal an, dass irgendwo auch etwas steht was addiert werden kann.
Beispiel: Dein Bereich geht von O6:O20. Sobald in einer Zelle in diesem Bereich z.B. O15 etwas steht ist deine If-Abfrage erfüllt.

If Sheets("Ziel").Range("O6:O" & letztezeile).Value Or Sheets("Ziel").Range("H6:H" &  _
letztezeile).Value <> "" Then
Sheets("Ziel").Range("O6:O" & letztezeile).Value = Sheets("Ziel").Range("H6:H" & letztezeile).Value + Sheets("Ziel").Range("O6:O" & letztezeile).Value
Du willst aber einzelne Zellen auf ungleich leer prüfen. Da musst du dann eine Schleifendrüber lassen.
For i = 6 To letztezeile
With Sheets("Ziel")
If .Cells(i, 15) <> "" Or .Cells(i, 8) <> "" Then
.Cells(i, 15) = .Cells(i, 15) + .Cells(i, 8)
End If
End With
Next i
Natürlich nicht vergessen die Laufvariable i im Kopf des Codes als Long zu dimensionieren.
Ungetestet
Gruß Werner

 Bild

Beiträge aus den Excel-Beispielen zum Thema "Zugriff auf Access Datenbanken"