1. Diese Seite verwendet Cookies. Wenn du dich weiterhin auf dieser Seite aufhältst, akzeptierst du unseren Einsatz von Cookies. Weitere Informationen

Abfrage mit 2 Codes gleichzeitig

Dieses Thema im Forum "Visual Basic 6.0, VBA & VBScript" wurde erstellt von josef24, 1. Dezember 2017.

  1. josef24

    josef24 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 (Text):
    1. Private Sub Problem()   ' Die Tabelle Zuzahlung
    2. Dim Zeile As Long
    3. Dim ZeileMax As Long
    4. Dim i As Long
    5. '  .AutoFilter 4, 1
    6. With Worksheets("Zuza")
    7. Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
    8. Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
    9. Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
    10. Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
    11. Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
    12.    Worksheets("ArbTab").Range("n1:n430").Copy
    13.     Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
    14.    Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
    15. Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
    16.     ZeileMax = .UsedRange.Rows.Count
    17.     n = 1
    18.  
    19.     For Zeile = 1 To ZeileMax
    20.         Next Zeile
    21.         End With
    22. End Sub
    2.: Auswahl treffen aus kopierten Daten
    Code (Text):
    1. Sub test_neu()
    2. Dim a As Long, i As Long
    3. Dim arr As Variant
    4. Dim Header As Boolean
    5. Application.ScreenUpdating = False
    6. a = 1
    7. a = Worksheets("Tabelle2").Cells(Rows.Count, 1).End(xlUp).Row + 1
    8. With Worksheets("Tabelle1")
    9.     arr = .Range("A1").CurrentRegion
    10.     For i = LBound(arr) + Abs(Header) To UBound(arr)
    11.         If arr(i, 6) Like "*A*" Or arr(i, 7) Like "*a*" Or (arr(i, 8) >= 1 And arr(i, 8) <= 90) Then
    12.             .Rows(i).Copy _
    13.                 Destination:=Worksheets("Tabelle2").Rows(a)
    14.             a = a + 1
    15.         End If
    16.     Next i
    17. End With
    18. Application.ScreenUpdating = True
    19. End Sub
     
  2. Yaslaw

    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
     
  3. josef24

    josef24 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
     
  4. Yaslaw

    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.
     
  5. josef24

    josef24 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 (Text):
    1. Private Sub Problem()   ' Die Tabelle Problem
    2. Dim Zeile As Long
    3. Dim ZeileMax As Long
    4. Dim i As Long
    5. Dim arr As Variant
    6. Application.ScreenUpdating = False
    7. i = 1
    8.  
    9.         If arr(i, 19) > " " Or (arr(i, 14) >= 1 And arr(i, 14) <= 40) Then
    10.  
    11. With Worksheets("Problem")
    12. Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
    13. Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
    14. Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
    15. Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
    16. Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
    17.    Worksheets("ArbTab").Range("n1:n430").Copy
    18.     Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
    19. Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
    20. Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
    21.         ZeileMax = .UsedRange.Rows.Count
    22.             i = 1
    23.                 For Zeile = 1 To ZeileMax
    24.             Next Zeile
    25.         End With
    26.         End If
    27. End Sub
     
  6. josef24

    josef24 Mitglied

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

    Code (Text):
    1. Private Sub Problem()   ' Die Tabelle Problem
    2. Dim Zeile As Long
    3. Dim ZeileMax As Long
    4.   Dim i As Long
    5. Dim a As String
    6. Dim arr As Variant
    7. Application.ScreenUpdating = False
    8. a = 1
    9.  
    10. ThisWorkbook.Worksheets("ArbTab").Activate
    11. If Range("S1:S250").Value >= "*A*" Then
    12. ' With Worksheets("Problem")
    13. Worksheets("Problem").Range("A1:z430").ClearContents  ' LÖSCHEN der alten Daten???????
    14. Worksheets("ArbTab").Range("a1:a430").Copy Destination:=Worksheets("Problem").Range("a1")    ' Nummer
    15. Worksheets("ArbTab").Range("c1:c430").Copy Destination:=Worksheets("Problem").Range("b1")    ' Name
    16. Worksheets("ArbTab").Range("d1:d430").Copy Destination:=Worksheets("Problem").Range("c1")    ' Vorname
    17. Worksheets("ArbTab").Range("l1:l430").Copy Destination:=Worksheets("Problem").Range("d1")    ' genBis
    18.    Worksheets("ArbTab").Range("n1:n430").Copy
    19.     Worksheets("Problem").Range("e1").PasteSpecial Paste:=xlValues                              ' Tage gültig
    20. Worksheets("ArbTab").Range("s1:s430").Copy Destination:=Worksheets("Problem").Range("f1")     ' Bemerkung
    21. Worksheets("ArbTab").Range("y1:y430").Copy Destination:=Worksheets("Problem").Range("g1")    ' Zahlung
    22.     '    ZeileMax = .UsedRange.Rows.Count
    23.             a = a + 1
    24.                 For Zeile = 1 To ZeileMax
    25.             Next Zeile
    26.         End With
    27.         End If
    28. End Sub
     
  7. Yaslaw

    Yaslaw n/a Moderator

    Und auf welcher Zeile?
     
  8. josef24

    josef24 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
     
  9. Yaslaw

    Yaslaw n/a Moderator

    Kannst du mir mal sagen was das soll?
    Code (Text):
    1. Dim a As String
    2. a = 1
    3. 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.
     
  10. josef24

    josef24 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:

  11. Yaslaw

    Yaslaw n/a Moderator

    Makro aufnehmen und schauen was geschrieben wird.
    Code (Visual Basic):
    1. Sub Macro2()
    2.     Rows("1:1").Select
    3.     Selection.AutoFilter
    4.     ActiveSheet.Range("$A$1:$H$6").AutoFilter Field:=6, Criteria1:=">A" , _
    5.         Operator:=xlAnd
    6.     ActiveSheet.Range("$A$1:$H$6").AutoFilter Field:=8, Criteria1:="<50", _
    7.         Operator:=xlAnd
    8. End Sub
    Anschliessend unnötiges Entfernen und das ganze testen
    Code (Visual Basic):
    1. Sub Macro2()
    2.     Rows("1:1").Select
    3.     Selection.AutoFilter
    4.     ActiveSheet.Range("$A$1:$H$6").AutoFilter Field:=6, Criteria1:=">A"
    5.     ActiveSheet.Range("$A$1:$H$6").AutoFilter Field:=8, Criteria1:="<50"
    6. End Sub
     
  12. josef24

    josef24 Mitglied

    Hallo und Danke. Der Filter entspricht natürlich den Vorgaben aus meiner letzten Anfrage, dafür ein Dankeschön. Wahrscheinlich ist es meine Unterlassung, nochmal extra zu erwähnen, das mein Filter die sowohl als auch Funktion haben sollte. Es wäre jede Spalte (6 + 8) zu berücksichtigen die einen Eintrag aufweist. Vielleicht kann der Anhang das verdeutlichen. Es soll ja gleichzeitig der gefilterte Datenumfang in eine neue Tabelle geschrieben werden. (geschieht hiermit auch)
    Danke nochmal bis dahin. Gruß Josef
    Code (Text):
    1. Sub Wolli()
    2.  
    3.     Dim wsZ As Worksheet
    4.  
    5.     Set wsZ = Tabelle2
    6.     With Tabelle1.Range("A1:z300")
    7.     Rows("1:1").Select
    8.         Selection.AutoFilter
    9.         ActiveSheet.Range("$A$1:$H$16").AutoFilter Field:=6, Criteria1:=">=a", Operator:=xlOr
    10.         ActiveSheet.Range("$A$1:$H$16").AutoFilter Field:=8, Criteria1:="<=110", Operator:=xlOr
    11.    
    12.             wsZ.Range("A1:Z300").ClearContents
    13.                  With .Parent.AutoFilter.Range
    14.                   .Columns(1).Copy Destination:=wsZ.Range("a1")
    15.                   .Columns(2).Copy Destination:=wsZ.Range("b1")
    16.                   .Columns(3).Copy Destination:=wsZ.Range("c1")
    17.                     .Columns(4).Copy Destination:=wsZ.Range("d1")
    18.                    .Columns(5).Copy Destination:=wsZ.Range("e1")
    19.                    .Columns(6).Copy Destination:=wsZ.Range("f1")
    20.                    .Columns(7).Copy Destination:=wsZ.Range("g1")
    21.                    .Columns(8).Copy
    22.                     wsZ.Range("h1").PasteSpecial Paste:=xlValues
    23.                 End With
    24.             .AutoFilter
    25.         End With
    26.     Application.CutCopyMode = False
    27.  
    28. End Sub
     
  13. Yaslaw

    Yaslaw n/a Moderator

    Hab mal schnell Google angeworfen und etwas gefunden.
    AdvencedFilter: http://www.contextures.com/xladvfilter01.html
    Damit kann man auch gleich kopieren!

    Angewendet auf dein Problem
    Code (Visual Basic):
    1. Sub Macro1()
    2.     Dim wsFilter As Worksheet
    3.     Dim wsSource As Worksheet
    4.     Dim wsTarget As Worksheet
    5.    
    6.     'Worksheets definieren
    7.    Set wsSource = ActiveWorkbook.Worksheets("Tabelle1")
    8.     Set wsTarget = ActiveWorkbook.Worksheets("Tabelle2")
    9.     wsTarget.UsedRange.ClearContents
    10.  
    11.     'Filtersheet erstellen
    12.    Set wsFilter = ActiveWorkbook.Worksheets.add()
    13.     wsFilter.name = "FILTER"
    14.    
    15.     'Filter erstellen
    16.    'http://www.contextures.com/xladvfilter01.html -> AND vs OR
    17.    
    18.     '  | A         | B           |
    19.    '-----------------------------
    20.    '1 | Bemerkung | Tage gültig |
    21.    '2 | >A        |             |
    22.    '3 |           | <50         |
    23.    
    24.     'Spaltennamen übernehmen
    25.    wsFilter.Range("A1").value = wsSource.Range("F1").value
    26.     wsFilter.Range("B1").value = wsSource.Range("H1").value
    27.     'Bedinungen einfügen. Für OR auf verscheidenen Zeilen
    28.    wsFilter.Range("A2").value = ">A"
    29.     wsFilter.Range("B3").value = "<50"
    30.    
    31.     'Daten filtern und kopieren
    32.    wsSource.UsedRange.AdvancedFilter xlFilterCopy, wsFilter.UsedRange, wsTarget.Range("A1"), False
    33.    
    34.     'Filtersheet wieder löschen
    35.    Application.DisplayAlerts = False
    36.     wsFilter.Delete
    37.     Application.DisplayAlerts = True
    38. End Sub
     
  14. josef24

    josef24 Mitglied

    Ja, genau so etwas hatte ich gesucht. Hast wohl mit einem speziellen Suchnamen viel bessere Möglichkeiten auswählen können, als es mir möglich war. Dafür vielen vielen Dank. Eine Frage noch: Darf ich jemand anderes auf diese Seite verweisen, der mit ähnlichem Problem beschäftigt war? Nochmals vielen Dank und noch eine schöne Zeit. Herzliche Grüße Josef
     
  15. Yaslaw

    Yaslaw n/a Moderator

    Das ist ein offenes Forum. Du darfst jeden hierher verweisen. Das ist sogar erwünscht!
    Rechts unter jedem Beitrag hat es eine Nummer mit einem Link. In diesem Beispiel #13 . Am besten diesen Link posten, dann führt er direkt zur Lösung.

    Googlesuchbegriff: excel autofilter or multiple columns
     
  16. josef24

    josef24 Mitglied

    Hallo und einen schönen Tag wünsche ich. Wie schon erwähnt, das Programm läuft super. Möchte noch das sich die Tabelle1 zum Abschluss direkt öffnet. Dazu habe ich folgende Ergänzung eingebracht. Damit komme ich aber nicht weiter, weil er mir irgendeine Tabelle1 zeigt, aber nicht die von mir gewollte. Hänge mal den entsprechenden Code- abschnitt an. Danke bis dahin. Gruß Josef
    Code (Text):
    1.     'Filtersheet wieder löschen
    2.    Application.DisplayAlerts = False
    3.     wsFilter.Delete
    4.     Application.DisplayAlerts = True
    5.  
    6.        Application.Dialogs(xlDialogOpen).Show "Tabelle1"
    7.            
    8. End Sub
     
  17. Yaslaw

    Yaslaw n/a Moderator

    Wozu über einen Dialog? Das ist etwa der komplizierteste unbrauchbarste Weg den es gibt.
    Tabelle1 ist doch die Variable wsSource.
    Dann ists ganz einfach
    Code (Text):
    1. wsSource.Select
     
  18. josef24

    josef24 Mitglied

    Danke, das ist ja noch einfacher wie ich gedacht hatte. Gruß Josef
     
Die Seite wird geladen...