Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
24.07.2017 17:49:33 |
Lancelot |
|
|
|
24.07.2017 17:52:35 |
Gast58893 |
|
|
|
24.07.2017 22:47:44 |
Werner |
|
|
Bug: Finden von nicht vorhandenen Werten |
25.07.2017 09:35:53 |
Gast70117 |
|
|
Von:
Gast70117 |
Datum:
25.07.2017 09:35:53 |
Views:
580 |
Rating:
|
Antwort:
|
Thema:
Bug: Finden von nicht vorhandenen Werten |
Liebe Leute,
ich bin langsam am Verzweifeln. Hier mein Programm:
posNo(1) = "0000"
posNo(2) = "9"
posNo(3) = "0301"
posNo(4) = "0302"
posNo(5) = "x" '"0305"
posNo(6) = "x" '"0320"
posNo(7) = "0341"
posNo(8) = "0342"
posNo(9) = "x" '"0345"
posNo(10) = "0360"
posNo(11) = "0381"
posNo(12) = "0382"
posNo(13) = "0401"
posNo(14) = "0402"
posNo(15) = "0451"
posNo(16) = "0452"
posNo(17) = "x" '"0465"
posNo(18) = "x" '"0466"
posNo(19) = "x" '"0467"
posNo(20) = "x" '"0468"
posNo(21) = "0471"
posNo(22) = "0472"
posNo(23) = "0481"
posNo(24) = "0482"
Worksheets(1).Activate
counter = 0
With Worksheets(1).Range("a2:a" & lastRow)
Set rng = .Find(9, LookIn:=xlValues)
If Not rng Is Nothing Then
firstAddress9 = rng.Address
Do
counter = counter + 1
Set rng = .FindNext(rng)
If rng Is Nothing Then
GoTo DoneFinding9
End If
Loop While Not rng Is Nothing And rng.Address <> firstAddress9
End If
DoneFinding9:
End With
For counterVar = 1 To counter
For controlVar = 1 To 24
With Worksheets(1).Range("a2:a" & lastRow)
Set rng = Nothing
Set rng = .Find(posNo(controlVar), LookIn:=xlValues)
MsgBox posNo(controlVar)
If Not rng Is Nothing Then
firstAddress = rng.Address
Do
MsgBox rng
rng.Select
cellRow = ActiveCell.Row
cellColumn = ActiveCell.Column
Cells(cellRow, cellColumn).EntireRow.Select
Selection.Cut
Sheets("Etikettenformate").Select
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row + 1
Cells(lastRow, 1).Select
ActiveSheet.Paste
Worksheets(1).Activate
lastRow = ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row
x = counterVar * controlVar
Range("a2:a" & lastRow).Select
If rng Is Nothing Then
GoTo DoneFinding
End If
Loop While Not rng Is Nothing And rng.Address <> firstAddress
End If
DoneFinding:
End With
Next controlVar
Next counterVar
Und täglich grüßt das Autofilter ;-))))))))))))
Option Explicit
Sub ADemo()
Dim posNo(1 To 24), Arr()
posNo(1) = "0000"
posNo(2) = "9"
posNo(3) = "0301"
posNo(4) = "0302"
posNo(5) = "x" '"0305"
posNo(6) = "x" '"0320"
posNo(7) = "0341"
posNo(8) = "0342"
posNo(9) = "x" '"0345"
posNo(10) = "0360"
posNo(11) = "0381"
posNo(12) = "0382"
posNo(13) = "0401"
posNo(14) = "0402"
posNo(15) = "0451"
posNo(16) = "0452"
posNo(17) = "x" '"0465"
posNo(18) = "x" '"0466"
posNo(19) = "x" '"0467"
posNo(20) = "x" '"0468"
posNo(21) = "0471"
posNo(22) = "0472"
posNo(23) = "0481"
posNo(24) = "0482"
Dim Rng As Range, x
With Worksheets(1)
If .AutoFilterMode Then Cells.AutoFilter
Set Rng = .UsedRange
Rng.AutoFilter Field:=1, Criteria1:=posNo, Operator:=xlFilterValues
Set Rng = Rng.SpecialCells(12)
For x = 2 To Rng.Areas.Count
Rng.Areas(x).Copy Sheets("Etikettenformate").Cells(Rows.Count, 1).End(xlUp).Offset(1)
Next x
For x = Rng.Areas.Count To 2 Step -1
Rng.Areas(x).EntireRow.Delete
Next x
.Cells.AutoFilter
End With
End Sub
|
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Bitte geben Sie ein aussagekräftiges Thema an.
Bitte geben Sie eine gültige Email Adresse ein!
- Bitte beschreiben Sie Ihr Problem möglichst ausführlich. (Wichtige Info z.B.: Office Version, Betriebssystem, Wo genau kommen Sie nicht weiter)
- Bitte helfen Sie ebenfalls wenn Ihnen geholfen werden konnte und markieren Sie Ihre Anfrage als erledigt (Klick auf Häckchen)
- Bei Crossposting, entsprechende Links auf andere Forenbeiträge beifügen / nachtragen
- Codeschnipsel am besten über den Code-Button im Text-Editor einfügen
- Die Angabe der Emailadresse ist freiwillig und wird nur verwendet, um Sie bei
Antworten auf Ihren Beitrag zu benachrichtigen
Thema
|
Datum
|
Von Nutzer
|
Rating
|
Antwort
|
|
24.07.2017 17:49:33 |
Lancelot |
|
|
|
24.07.2017 17:52:35 |
Gast58893 |
|
|
|
24.07.2017 22:47:44 |
Werner |
|
|
Bug: Finden von nicht vorhandenen Werten |
25.07.2017 09:35:53 |
Gast70117 |
|
|