Abfrage mit 2 Codes gleichzeitig

josef24

Erfahrenes Mitglied
Ich versuche in einem Arbeitsschritt 2 "Querys" unter zu bringen, also zu verbinden wie z. B. Union all es bei QMF macht. geht das überhaupt ist meine erste Frage. Wenn ja........
Ich möchte einmal Daten kopieren, und im 2ten Schritt spezifische Werte ansprechen, und aufbereiten lassen. (Wurde im Forum schon gelöst)
Kann mir hierfür jemand einen Lösungsansatz bzw. ein Beispiel liefern.

Meine Codes:

1.: Kopieren aus der Stammdatei in die Arbeitsdatei!
Code:
Private Sub Problem()   ' Die Tabelle Zuzahlung
Dim Zeile As Long
Dim ZeileMax As Long
Dim i As Long
'  .AutoFilter 4, 1
With Worksheets("Zuza")
Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
   Worksheets("ArbTab").Range("n1:n430").Copy
    Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
   Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
    ZeileMax = .UsedRange.Rows.Count
    n = 1

    For Zeile = 1 To ZeileMax
        Next Zeile
        End With
End Sub

2.: Auswahl treffen aus kopierten Daten
Code:
Sub test_neu()
Dim a As Long, i As Long
Dim arr As Variant
Dim Header As Boolean
Application.ScreenUpdating = False
a = 1
a = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1
With Worksheets("Tabelle1")
    arr = .Range("A1").CurrentRegion
    For i = LBound(arr) + Abs(Header) To UBound(arr)
        If arr(i, 6) Like "*A*" Or arr(i, 7) Like "*a*" Or (arr(i, 8) >= 1 And arr(i, 8) <= 90) Then
            .Rows(i).Copy _
                Destination:=Worksheets("Tabelle2").Rows(a)
            a = a + 1
        End If
    Next i
End With
Application.ScreenUpdating = True
End Sub
 

Yaslaw

n/a
Moderator
1) Was ist QMF?

2) UNION ALL ist SQL. Dein Code hat nix mit SQL zu tun.

3) Diese 2 Methoden basieren auf verschiedenen Tabellen und verschieden Tabellen. Ausser das Beide irgendwelche Werte kopieren sehe ich keinen Zusammenhang

4) Formatiere deine erste Methode in eine lesbare Form
 

josef24

Erfahrenes Mitglied
Danke, erst mal. Du hast natürlich recht. Es ist SQL gewesen, lange her. Ich hatte vielmehr an eine Prozedur gedacht, so kannte ich es in SQL. Daten aus erstem Code in Tabelle ....... kopieren, und mit mit zweiter Methode die Auswahl treffen und abspeichern. Ist das so verständlich? Gruß Josef
 

Yaslaw

n/a
Moderator
Nö. Das ist nicht verständlich.

Und wo ist das Problem? Du hast alle Befehle die du brauchst.
Du hast Befehle zum Kopieren und zum eine Auswahl treffen.

Setz dich hin und versuche mal einen Code dazu zu schreiben. Schau die die F1-Hilfe zu den Befehlen die du nicht kennst an.
 

josef24

Erfahrenes Mitglied
Danke, es gibt sicher eine einfachere Lösung. Stelle dazu mal was hier ein. Ich kopiere bestimmte Spalten in eine neue Tabelle, wobei ich eine gewisse Spalten-Auswahl treffe. Damit könnte ich den kopierten Tabelleninhalt direkt weiter verwenden. Mein Problem ist Fehler "Typenunverträglichkeit",
"Laufzeitfehler13 " und ich kenne keine Möglichkeit dies zu beseitigen. Danke für etwaige Hilfe. Gruß Josef

Code:
Private Sub Problem()   ' Die Tabelle Problem
Dim Zeile As Long
Dim ZeileMax As Long
Dim i As Long
Dim arr As Variant
Application.ScreenUpdating = False
i = 1

        If arr(i, 19) > " " Or (arr(i, 14) >= 1 And arr(i, 14) <= 40) Then

With Worksheets("Problem")
Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
   Worksheets("ArbTab").Range("n1:n430").Copy
    Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
        ZeileMax = .UsedRange.Rows.Count
            i = 1
                For Zeile = 1 To ZeileMax
            Next Zeile
        End With
        End If
End Sub
 

josef24

Erfahrenes Mitglied
Hab es mal etwas verändert, aber es reicht einfach nicht. hier mein zweiter Versuch. Gruß Josef

Code:
Private Sub Problem()   ' Die Tabelle Problem
Dim Zeile As Long
Dim ZeileMax As Long
  Dim i As Long
Dim a As String
Dim arr As Variant
Application.ScreenUpdating = False
a = 1

ThisWorkbook.Worksheets("ArbTab").Activate
If Range("S1:S250").Value >= "*A*" Then
' With Worksheets("Problem")
Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
   Worksheets("ArbTab").Range("n1:n430").Copy
    Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
    '    ZeileMax = .UsedRange.Rows.Count
            a = a + 1
                For Zeile = 1 To ZeileMax
            Next Zeile
        End With
        End If
End Sub
 

josef24

Erfahrenes Mitglied
Danke erst mal. Es wird auf keine Zeile verwiesen. Also allgemeiner Hinweis. Noch eine Anmerkung: Hatte mich im Netz Office und so etwas versucht zu informieren, und da lass ich immer von Spezialfilter einrichten. Weiß nun nicht ob das für mein Anliegen ebenfalls zutrifft. Gruß Josef
 

Yaslaw

n/a
Moderator
Kannst du mir mal sagen was das soll?
Code:
Dim a As String
a = 1
a = a + 1
Und wo wird ZeileMax ermittelt?

Und nochmals. Formatiere deinen Code! Das Ding ist unlesbar!
Ich weigere mich grundsätzlich unformatierten Code zu lesen, weil ich einfach keine Lust habe durch Zählen herauszufinden was wo beginnt und wo endet.
Auch sonst hast du alle meine bisherigen Tipps in den Wind geschlagen. Ich frage mich, warum ich mir überhaupt die Mühe mache deine Copy&Paste Codes weiter anzuschauen.
 

josef24

Erfahrenes Mitglied
Hallo und guten Abend. Ich will mein Problem nochmals in jetzt geänderter Form veröffentlichen. Gestehe, habe in Foren etwas abgekupfert.
Mit dem Daten kopieren bin ich zufrieden, läuft auch. Wo ich aber bis jetzt keine Lösung gefunden habe, ist: Die Daten aus zwei Spalten ausgewählt beim Kopiervorgang korrekt zu übermitteln. Ich habe das Problem mit Auswahl in zwei Spalten schon öfters versucht zu lösen, bisher aber nie mit Erfolg gekrönt.
Eine Spalte, 2 Fragen geht ja, aber aus zwei Spalten, wie gesagt???????
Ich denke mal das ich doch nicht der Einzige sein werde der eine solche Auswahl mal kreieren musste. Habe schon Interesse anderer User mit meiner Frage neugierig gemacht. Hänge mal die Datei an, um ggf. am Beispiel zu testen. Guten Abend und Gruß Josef
 

Anhänge

  • Test Dat 1 (2).zip
    27,7 KB · Aufrufe: 4

Neue Beiträge