Vba excel sortieren von auswertungen

Computer: Software & Programmierung Visual Basic
#1

Hallo liebe Experten

da mir hier schon soooo super tatkräftig geholfen wurde, würde ich gerne in
Erfahrung bringen, wie ich die Auswertung in einer bestimmten Reihenfolge bekomme…

Private Sub CommandButton1_Click()
Dim wSTAT As Worksheet, wAUSW As Worksheet
Dim aUr, aZiel()
Dim iUr As Long, iZiel As Long
Set wSTAT = Worksheets(„BU-Status“)
Set wAUSW = Worksheets(„BU-Auswertung“)
wAUSW.Range(„A2:G10000“).ClearContents
aUr = wSTAT.Range(„D50:AY1401“).Value
ReDim aZiel(UBound(aUr), 7)
For iUr = 1 To UBound(aUr)
If aUr(iUr, 18) = 1 Then
If aUr(iUr, 47) > 2 Then
If InStr("#CH#ST#AV#DDC#", „#“ & aUr(iUr, 48) & „#“) > 0 Then
aZiel(iZiel, 0) = aUr(iUr, 1)
aZiel(iZiel, 1) = aUr(iUr, 9)
aZiel(iZiel, 2) = aUr(iUr, 10)
aZiel(iZiel, 3) = aUr(iUr, 20)
aZiel(iZiel, 4) = aUr(iUr, 21)
aZiel(iZiel, 5) = aUr(iUr, 47)
aZiel(iZiel, 6) = aUr(iUr, 48)
iZiel = iZiel + 1
End If
End If
End If
Next iUr
If iZiel > 0 Then wAUSW.Range(„A2:G1352“) = aZiel
End Sub

Alle gefunden Daten sollen in der Spalte G in „BU-Auswertung“ dieser
Reihenfolge übernommen werden,…„CH“, „ST“, „AV“ dann „DDC“.
Natürlich nur, wenn diese im Arbeitsblatt „BU-Status“ vorhanden sind.

Viele Grüße
Melanie

#2

Erfahrung bringen, wie ich die Auswertung in einer bestimmten
Reihenfolge bekomme…
Alle gefunden Daten sollen in der Spalte G in „BU-Auswertung“
dieser
Reihenfolge übernommen werden,…„CH“, „ST“, „AV“ dann „DDC“.
Natürlich nur, wenn diese im Arbeitsblatt „BU-Status“
vorhanden sind.

Hallo Melanie,

benutze bitte den Pre-Tag beim Code zeigen.

Gruß
Reinhard

Private Sub CommandButton1\_Click()
Dim wSTAT As Worksheet, wAUSW As Worksheet
Dim aUr, aZiel(), bZiel(), arrVergl, A As Integer, I As Integer
Dim iUr As Long, iZiel As Long, B As Integer
Set wSTAT = Worksheets(1) '("BU Status")
Set wAUSW = Worksheets(2) '("BU Auswertung")
wAUSW.Range("A2:F1351").ClearContents
aUr = wSTAT.Range("D50:AY1401").Value
ReDim aZiel(UBound(aUr), 6)
arrVergl = Array("CH", "ST", "AV", "DDC")
For iUr = 1 To UBound(aUr)
 If aUr(iUr, 18) = 1 Then
 If aUr(iUr, 47) \> 2 Then
 If InStr("#AV#ST#CH#DDC#", "#" & aUr(iUr, 48) & "#") \> 0 Then
 aZiel(iZiel, 0) = aUr(iUr, 1) 'D
 aZiel(iZiel, 1) = aUr(iUr, 9) 'L
 aZiel(iZiel, 2) = aUr(iUr, 20) 'W
 aZiel(iZiel, 3) = aUr(iUr, 21) 'X
 aZiel(iZiel, 4) = aUr(iUr, 47) 'AX
 aZiel(iZiel, 5) = aUr(iUr, 48) 'AY
 iZiel = iZiel + 1
 End If
 End If
 End If
Next
If iZiel = 0 Then Exit Sub
ReDim bZiel(iZiel - 1, 5)
For A = 0 To UBound(arrVergl)
 For I = 0 To iZiel
 If aZiel(I, 5) = arrVergl(A) Then
 bZiel(B, 0) = aZiel(I, 0)
 bZiel(B, 1) = aZiel(I, 1)
 bZiel(B, 2) = aZiel(I, 2)
 bZiel(B, 3) = aZiel(I, 3)
 bZiel(B, 4) = aZiel(I, 4)
 bZiel(B, 5) = aZiel(I, 5)
 B = B + 1
 End If
 Next I
Next A
wAUSW.Range("A2:F" & 1 + iZiel) = bZiel
End Sub
#3

Super! Vielen Dank! Funktioniert einwandfrei.
Habe mir den Code nur etwas angepasst bzw. um eine Spalte erweitert.

Viele Grüsse
Melanie