VBA Exce: Case mit mehreren Variablen

Question

Hallo zusammen,

ich benötige eure Hilfe. Mithilfe einer FOR-Schleife werden einzelne Cases abgefragt und wenn der Textteil übereinstimmt, werden einzelne Werte aus dieser Zeile in ein anderes Blatt geschrieben.

Der Code funktioniert soweit, jedoch gibt es das Problem, dass bei gewissen Cases mehrere Textvariablen abgefragt und strPartner übergeben werden müssen.

Nachfolgend findet ihr einen Codeauszug:

' ** ABFRAGE DER EINZELNEN PARTNER

For lngPartner = 1 To 99

  'Daten für Partner
  Select Case lngPartner
   
    Case 1
       A = 25
       strPartner = "West AG**"
    Case 2
       A = 65
       strPartner = "Ost AG*"
    Case 3
       A = 105
       strPartner = "Nord AG*"
    Case 4
       A = 145
       strPartner = "Süd AG*" OR "Sued AG*"
   usw...

Für Case 4 habe ich es mit folgendem Code versucht, jedoch ohne Erfolg:

strPartner 1 = "SüdAG*"

strPartner2 = "SuedAG*"

strPartner = strPartner1 + strPartner2

gibt es hierfür eine einfache Lösung? Vielen Dank im Voraus für eure Bemühungen.

Gruss Andreas

Answer 1

Hallo Andreas,

vielleicht einfach so (?):

Case 4
       A = 145
       strPartner = "Süd AG / Sued AG*"

Und wenn du zwei Strings zusammensetzen willst, dann nicht mit + sondern mit &.

Gruß

M.O.

Answer 2

Hallo M.O.

vielen Dank für die prompte Antwort. Leider funktionieren beide Lösungsvorschläge nicht.

Es wird immer nur der zweite String "Sued AG*" übergeben.

Danke für weitere Lösungsvorschläge.

Gruss Andreas

Answer 3

Hallo Andreas,

hier mal ein Beispiel wie man dein Problem lösen könnte:

Sub beispiel()

Dim lngPartner As Long
Dim arrPartner() As String       'Array für Name des Partners
Dim A As Long
Dim d As Long

'Bitte erst eine Zahl zwischen 1 und 4 in Zelle A1 schreiben
lngPartner = Cells(1, 1)

Select Case lngPartner
   
    Case 1
       A = 25
       'Datenfeld wird redimensionert, bei 1 Eintrag = 0 da Feld mit 0 anfängt
       ReDim arrPartner(0)
       'Datenfeld wird gefüllt
       arrPartner(0) = "West AG**"
    Case 2
       A = 65
       ReDim arrPartner(0)
       arrPartner(0) = "Ost AG*"
    Case 3
       A = 105
       ReDim arrPartner(0)
       arrPartner(0) = "Nord AG*"
    Case 4
       A = 145
       ReDim arrPartner(1)
       arrPartner(0) = "Süd AG*"
       arrPartner(1) = "Sued AG*"

End Select

For d = LBound(arrPartner) To UBound(arrPartner)
   'hier steht dann deine Suchroutine
   MsgBox arrPartner(d)
Next d

End Sub

Gruß

M.O.

Answer 4

Hallo M.O.

danke dir für deine Hilfe. Habe versucht den Code entsprechend anzupassen, jedoch kriege ich es nicht hin.

Am Ende beim Vergleich vom Array mit den Zellwerten erscheint die Fehlermeldung, dass die Typen unverträglich sind.

' ** ABFRAGE DER PARTNER

    For i = 1 To lngLZeile1    ' lngLZeile1 ist die letzte Zeile vom JReport wo ein Eintrag ist

      If WbDatei1.Sheets(1).Cells(i, 1) Like arrPartner() Then
      
        ' Datumsprüfung "Lieferzeitraum von"
        If WbDatei1.Sheets("Sheet1").Cells(i, 4).Value <= DateFrom Then
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 4).Value = DateFrom
        Else
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 4).Value = WbDatei1.Sheets("Sheet1").Cells(i, 4).Value
        End If
      
        ' Datumsprüfung "Lieferzeitraum bis"
        If WbDatei1.Sheets("Sheet1").Cells(i, 5).Value >= DateTo Then
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 5).Value = DateTo
        Else
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 5).Value = WbDatei1.Sheets("Sheet1").Cells(i, 5).Value
        End If
       
        ' Abgabe Menge
        WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 3).Value = WbDatei1.Sheets("Sheet1").Cells(i, 10).Value
       
        ' Betrag
        WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 8).Value = WbDatei1.Sheets("Sheet1").Cells(i, 11).Value
       
        A = A + 1
      End If
    Next i
 Next lngPartner

Kannst du mir nochmals weiterhelfen?

Meine VBA-Kenntnisse sind einfach zu schlecht.

Gruss Andreas

Answer 5

Hallo Andreas,

schau mal, ob es so funktioniert:

'Array mit Partnern durchlaufen
For d = LBound(arrPartner) To UBound(arrPartner)
    'Suchroutine
    For i = 1 To lngLZeile1    ' lngLZeile1 ist die letzte Zeile vom JReport wo ein Eintrag ist

      If WbDatei1.Sheets(1).Cells(i, 1) Like arrPartner(d) Then
      
        ' Datumsprüfung "Lieferzeitraum von"
        If WbDatei1.Sheets("Sheet1").Cells(i, 4).Value <= DateFrom Then
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 4).Value = DateFrom
        Else
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 4).Value = WbDatei1.Sheets("Sheet1").Cells(i, 4).Value
        End If
      
        ' Datumsprüfung "Lieferzeitraum bis"
        If WbDatei1.Sheets("Sheet1").Cells(i, 5).Value >= DateTo Then
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 5).Value = DateTo
        Else
            WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 5).Value = WbDatei1.Sheets("Sheet1").Cells(i, 5).Value
        End If
       
        ' Abgabe Menge
        WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 3).Value = WbDatei1.Sheets("Sheet1").Cells(i, 10).Value
       
        ' Betrag
        WbDatei2.Sheets("Handelsgeschäfte").Cells(A, 8).Value = WbDatei1.Sheets("Sheet1").Cells(i, 11).Value
       
        A = A + 1
      End If
    Next i
 Next d

Gruß

M.O.

Answer 6

Hallo M.O.

vielen herzlichen Dank. Es funktioniert einwandfrei.

Du hast mir sicher bereits zum 3 Mal aus meiner Patsche geholfen :-).

Gruss Andreas

Answer 7

Hallo Andreas,

danke für die Rückmeldung. Und zum Helfen ist das Supportnet ja da .

Gruß

M.O.