Live-Forum - Die aktuellen Beiträge
Datum
Titel
19.04.2024 17:05:40
Zählen von Zeilen, in denen in bestimmten Bereich Daten sind
19.04.2024 16:34:52
gemeinsamer Filter über drei Spalten
19.04.2024 15:39:42
Exceltabelle daten per combobox zu word Datei
19.04.2024 14:04:05
PDF per VBA ausgeben - Seitenskalierung
Du findest keine passende Antwort auf Deine Frage?
Stelle Deine Frage in unserem Live-Forum
Anzeige
Archiv - Navigation
500to504
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Vorheriger Thread
Vorheriger Thread
Rückwärts Blättern
500to504
500to504
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Nächster Thread
Nächster Thread
Vorwärts blättern
Inhaltsverzeichnis

Bestimmten Bereich markieren

Bestimmten Bereich markieren
18.10.2004 08:42:00
KaJu
Hallo
Mit folgendem Teil meines Macros suche ich einen Mitarbeiter aus einer Tabelle:
cc = 0
plus:
cc = cc + 1
If cc &gt 80 Then GoTo ENDE
If Sheets("Mitarbeiter").Cells(cc, 2) &lt&gt ComboBox18 Then GoTo plus
Wenn er eine übereinstimmung hat, soll in Zeile cc die Spalten 4-47 gelöscht werden.
Wie schreibt man den RANGE Befehl mit einer nicht festen Zahl ?
Bei festen Werten ist mir das klar (Range("j4:j47").Selcet)
Aber bei mir ist das (im Beispiel j) ja nicht bekannt.
Kann mir jemand helfen?

10
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bestimmten Bereich markieren
Matthias
Hallo KaJu,
versuch es mal mit Range(cells(10,4),cells(10,47)).select.
Gruß, Matthias
P.S.: Anstatt der Zahlen kannst Du auch Variablen einsetzen.
AW: Bestimmten Bereich markieren
P@ulchen
Hi,
versuch mal so (nach Möglichkeit ohne GoTo):
Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
AW: Bestimmten Bereich markieren
18.10.2004 09:12:54
KaJu
Hi
Ja das ist im Moment ein Problem bei meiner Programierung
Ich habe das ganze Programm voll von GoTo befehlen, da ich mit den loop, for usw.. Befehlen noch nicht so gut klar komme.
Da muß ich noch viel lernen.
Hier nur mal ein Beispiel meiner grauenhaften Programierung, und es gibt noch schlimmere Stellen:
Range("a1").Select
cc = 0
alt:
'Überprüfen welche Mitarbeiter was können
xx = 0: gg = 2: ff = 39: cc = cc + 1
If cc = 82 Then GoTo endeende
Sheets("Mitarbeiter").Select: Cells(cc, 2).Select: wert3 = ActiveCell.Value
If wert3 = "" Then GoTo alt
'Sheets("leer").Cells(4, 5) = wert3
'If Cells(cc, 51) &lt&gt "" Then If Cells(cc, 51) &lt Date Then aushilfeweg.Show: If Sheets("leer").Cells(5, 5) = "1" Then Sheets("leer").Cells(5, 5) = "": GoTo ALT
SO:
SO1:
gg = 2: ff = 39
xx = xx + 3
If xx = 45 Then GoTo alt
Sheets("Mitarbeiter").Select
Cells(cc, xx).Select: masch = ActiveCell.Value
If masch = "" Then Cells(cc, 48).Select: masch = ActiveCell.Value: If masch = "" Then GoTo alt
ActiveCell.Offset(0, 1).Select: pri = ActiveCell.Value
lern = 0
anlernen1:
lern = lern + 1
If pri &lt&gt "9" Then GoTo anlernende1
If pri = "9" Then Sheets("s").Select
Cells(lern, 3).Select
If ActiveCell.Value &lt&gt "" Then GoTo anlernen1
ActiveCell.FormulaR1C1 = wert3: ActiveCell.Offset(0, 1).Select: ActiveCell.FormulaR1C1 = masch
Sheets("s").Select
Range("j2:ea81").Replace What:=wert3, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=Truefcb = 0
GoTo alt
anlernende1:
Sheets("S").Select
Werde deinen Code mal ausprobieren.
MfG
KaJu
Anzeige
ohje...wo hast Du denn das her ?
P@ulchen
und was heißt: "...es gibt noch schlimmere Stellen..." ? Schlimmer geht doch gar nicht !
Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
AW: ohje...wo hast Du denn das her ?
18.10.2004 10:54:35
KaJu
Hi
Schlimmer geht immer.
Ich habe mir das alles selber beigebracht, wie man sieht.
Würde mich gerne mal mit jemanden Treffen der mir da weiter hilft.
Aber das ist ein anderes Thema.
MfG
KaJu
AW: ohje...wo hast Du denn das her ?
P@ulchen
Hi KaJu,
es ist sicher nicht unbedingt nötig, sich zu treffen, um sich gegenseitig zu helfen.
Schau doch zB. mal hier: http://www.cmp-online.de/vba.htm.
Wenn Du Interesse hast, kann ich Dir auch ein paar pdf-Files zur VBA-Programmierung schicken...
Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
Anzeige
wie sieht das jetzt aus?
18.10.2004 14:32:08
KaJu
Hi
Ich habe folgenden Berich mal versucht zu ändern, gibt es noch verbesserungsvorschläge ?
ALTER CODE:
&ltpre&gt
Sub sortierenKF()
'
' Makro1 Makro
' Makro am 11.07.2003 von Karsten Jung aufgezeichnet
'
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Range("a1").Select
cc = 0
alt:
'Überprüfen welche Mitarbeiter was können
xx = 0: gg = 2: ff = 39: cc = cc + 1
If cc = 82 Then GoTo endeende
Sheets("Mitarbeiter").Select: Cells(cc, 2).Select: wert3 = ActiveCell.Value
If wert3 = "" Then GoTo alt
'Sheets("leer").Cells(4, 5) = wert3
'If Cells(cc, 51) &lt&gt "" Then If Cells(cc, 51) &lt Date Then aushilfeweg.Show: If Sheets("leer").Cells(5, 5) = "1" Then Sheets("leer").Cells(5, 5) = "": GoTo ALT
SO:
SO1:
gg = 2: ff = 39
xx = xx + 3
If xx = 45 Then GoTo alt
Sheets("Mitarbeiter").Select
Cells(cc, xx).Select: masch = ActiveCell.Value
If masch = "" Then Cells(cc, 48).Select: masch = ActiveCell.Value: If masch = "" Then GoTo alt
ActiveCell.Offset(0, 1).Select: pri = ActiveCell.Value
lern = 0
anlernen1:
lern = lern + 1
If pri &lt&gt "9" Then GoTo anlernende1
If pri = "9" Then Sheets("s").Select
Cells(lern, 3).Select
If ActiveCell.Value &lt&gt "" Then GoTo anlernen1
ActiveCell.FormulaR1C1 = wert3: ActiveCell.Offset(0, 1).Select: ActiveCell.FormulaR1C1 = masch
Sheets("s").Select
Range("j2:be81").Replace What:=wert3, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=Truefcb = 0
GoTo alt
anlernende1:
Sheets("S").Select
If masch = "SO1" Then fkk = 10: GoTo so1a
If masch = "SO6" Then fkk = 12: GoTo so1a
If masch = "SO8" Then fkk = 14: GoTo so1a
If masch = "QS7 QS-Führer" Then fkk = 16: GoTo so1a
If masch = "QS7 VP-Führer" Then fkk = 18: GoTo so1a
If masch = "QS14 QS-Führer" Then fkk = 20: GoTo so1a
If masch = "QS14 VP-Führer" Then fkk = 22: GoTo so1a
If masch = "PLS" Then fkk = 24: GoTo so1a
If masch = "RA2" Then fkk = 26: GoTo so1a
If masch = "RA5" Then fkk = 28: GoTo so1a
If masch = "RA5a" Then fkk = 30: GoTo so1a
If masch = "RA6" Then fkk = 32: GoTo so1a
If masch = "RA7" Then fkk = 34: GoTo so1a
If masch = "RA8" Then fkk = 36: GoTo so1a
If masch = "RA9" Then fkk = 38: GoTo so1a
If masch = "StaplerQS" Then fkk = 40: GoTo so1a
If masch = "StaplerFVP" Then fkk = 42: GoTo so1a
If masch = "Ungeriest" Then fkk = 44: GoTo so1a
If masch = "Sortierung" Then fkk = 46: GoTo so1a
If masch = "Retoure" Then fkk = 48: GoTo so1a
If masch = "QS7 QS-Gehilfe" Then fkk = 50: GoTo so1a
If masch = "QS7 VP-Gehilfe" Then fkk = 52: GoTo so1a
If masch = "QS14 QS-Gehilfe" Then fkk = 54: GoTo so1a
If masch = "QS14 VP-Gehilfe" Then fkk = 56: GoTo so1a
Mldg = "Sie haben bei ---&gt" + wert3 + " &lt--- eine unbekannte Maschine eingegeben, bitte baldmöglichst überprüfen!!! ---&gt " + masch + " &lt--- gibt es nicht oder ist falsch geschrieben (Ein Leerzeichen wo keins hingehört?)" ' Meldung definieren.
Stil = vbOKOnly + vbCritical ' Schaltflächen
' definieren.
Titel = "Falsche Maschine bei " + wert3 ' Titel definieren.
Antwort = MsgBox(Mldg, Stil, Titel) ' Meldung anzeigen.
GoTo SO
so1a:
Cells(gg, fkk).Select
If ActiveCell.Value &lt&gt "" Then gg = gg + 1: GoTo so1a
ActiveCell.Value = wert3: ActiveCell.Offset(0, 1).Select
ActiveCell.Value = pri: GoTo SO
Maschende:
GoTo SO
endeende:
Sheets("S").Select
Range("j2:k81").Sort Key1:=Range("k2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("l2:m81").Sort Key1:=Range("m2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("n2:o81").Sort Key1:=Range("o2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("p2:q81").Sort Key1:=Range("q2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("r2:s81").Sort Key1:=Range("s2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("t2:u81").Sort Key1:=Range("u2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("v2:w81").Sort Key1:=Range("w2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("x2:y81").Sort Key1:=Range("y2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("z2:aa81").Sort Key1:=Range("aa2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ab2:ac81").Sort Key1:=Range("ac2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ad2:ae81").Sort Key1:=Range("ae2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("af2:ag81").Sort Key1:=Range("ag2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ah2:ai81").Sort Key1:=Range("ai2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("aj2:ak81").Sort Key1:=Range("ak2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("al2:am81").Sort Key1:=Range("am2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("an2:ao81").Sort Key1:=Range("ao2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ap2:aq81").Sort Key1:=Range("aq2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ar2:as81").Sort Key1:=Range("as2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("at2:au81").Sort Key1:=Range("au2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("av2:aw81").Sort Key1:=Range("aw2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ax2:ay81").Sort Key1:=Range("ay2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("az2:ba81").Sort Key1:=Range("ba2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bb2:be81").Sort Key1:=Range("bc2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bd2:be81").Sort Key1:=Range("be2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bf2:bg81").Sort Key1:=Range("bg2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'sicherung anlegen
Sheets("s").Range("J2:be81").Copy Destination:=Sheets("s").Range("J100")
sortieren:
'TEST!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
wert99 = True: zähler = 0: ' Variablen initialisieren.
Do While zähler &lt 44 ' Länge bestimmen
zähler = zähler + 1 ' Zähler hochzählen.
If zähler = 1 Then zzzz = 14: zzzzzz = 3 ' Attributwert setzen für SO8.
If zähler = 2 Then zzzz = 12: zzzzzz = 2 ' Attributwert setzen für SO6.
If zähler = 3 Then zzzz = 10: zzzzzz = 1 ' Attributwert setzen für SO1.
If zähler = 4 Then zzzz = 20: zzzzzz = 8 ' Attributwert setzen für QS14 1.
If zähler = 5 Then zzzz = 54: zzzzzz = 9 ' Attributwert setzen für QS14 2.
If zähler = 6 Then zzzz = 16: zzzzzz = 4 ' Attributwert setzen für QS7 1.
If zähler = 7 Then zzzz = 50: zzzzzz = 5 ' Attributwert setzen für QS7 2.
If zähler = 8 Then zzzz = 22: zzzzzz = 10 ' Attributwert setzen für QS14 3.
If zähler = 9 Then zzzz = 56: zzzzzz = 11 ' Attributwert setzen für QS14 4.
If zähler = 10 Then zzzz = 18: zzzzzz = 6 ' Attributwert setzen für QS7 3.
If zähler = 11 Then zzzz = 52: zzzzzz = 7 ' Attributwert setzen für QS7 4.
If zähler = 12 Then zzzz = 42: zzzzzz = 32 ' Attributwert setzen für FVP 1.
If zähler = 13 Then zzzz = 42: zzzzzz = 33 ' Attributwert setzen für FVP 2.
If zähler = 14 Then zzzz = 42: zzzzzz = 34 ' Attributwert setzen für FVP 3.
If zähler = 15 Then zzzz = 24: zzzzzz = 12 ' Attributwert setzen für PLS 1.
If zähler = 16 Then zzzz = 24: zzzzzz = 13 ' Attributwert setzen für PLS 2.
If zähler = 17 Then zzzz = 24: zzzzzz = 14 ' Attributwert setzen für PLS 3.
If zähler = 18 Then zzzz = 38: zzzzzz = 26 ' Attributwert setzen für RA9 1.
If zähler = 19 Then zzzz = 38: zzzzzz = 27 ' Attributwert setzen für RA9 2.
If zähler = 20 Then zzzz = 36: zzzzzz = 24 ' Attributwert setzen für RA8 1.
If zähler = 21 Then zzzz = 36: zzzzzz = 25 ' Attributwert setzen für RA8 2.
If zähler = 22 Then zzzz = 34: zzzzzz = 22 ' Attributwert setzen für RA7 1.
If zähler = 23 Then zzzz = 34: zzzzzz = 23 ' Attributwert setzen für RA7 2.
If zähler = 24 Then zzzz = 26: zzzzzz = 15 ' Attributwert setzen für RA2 1.
If zähler = 25 Then zzzz = 26: zzzzzz = 16 ' Attributwert setzen für RA2 2.
If zähler = 26 Then zzzz = 30: zzzzzz = 19 ' Attributwert setzen für RA5a.
If zähler = 27 Then zzzz = 28: zzzzzz = 17 ' Attributwert setzen für RA5 1.
If zähler = 28 Then zzzz = 28: zzzzzz = 18 ' Attributwert setzen für RA5 2.
If zähler = 29 Then zzzz = 32: zzzzzz = 20 ' Attributwert setzen für RA6 1.
If zähler = 30 Then zzzz = 32: zzzzzz = 21 ' Attributwert setzen für RA6 2.
If zähler = 31 Then zzzz = 40: zzzzzz = 28 ' Attributwert setzen für QS 1.
If zähler = 32 Then zzzz = 40: zzzzzz = 29 ' Attributwert setzen für QS 2.
If zähler = 33 Then zzzz = 40: zzzzzz = 30 ' Attributwert setzen für QS 3.
If zähler = 34 Then zzzz = 40: zzzzzz = 31 ' Attributwert setzen für QS 4.
If zähler = 35 Then zzzz = 44: zzzzzz = 35 ' Attributwert setzen für UNG 1.
If zähler = 36 Then zzzz = 44: zzzzzz = 36 ' Attributwert setzen für UNG 2.
If zähler = 37 Then zzzz = 44: zzzzzz = 37 ' Attributwert setzen für UNG 3.
If zähler = 38 Then zzzz = 44: zzzzzz = 38 ' Attributwert setzen für UNG 4.
If zähler = 39 Then zzzz = 46: zzzzzz = 39 ' Attributwert setzen für SOR 1.
If zähler = 40 Then zzzz = 46: zzzzzz = 40 ' Attributwert setzen für SOR 2.
If zähler = 41 Then zzzz = 46: zzzzzz = 41 ' Attributwert setzen für SOR 3.
If zähler = 42 Then zzzz = 48: zzzzzz = 42 ' Attributwert setzen für Retoure.
If zähler = 43 Then zzzz = 46: zzzzzz = 44 ' Attributwert setzen für SOR 4.
If zähler = 44 Then zzzz = 24: zzzzzz = 43 ' Attributwert setzen für PLS 4.
fg = 1
SO8ba: 'SO8
fg = fg + 1
wert99 = Sheets("s").Cells(fg, zzzz).Value
If fg = 79 Then GoTo b
If wert99 = "" Then GoTo SO8ba
If Sheets("Besetzung").Cells(zzzzzz, 2).Value &lt&gt "" Then GoTo b
Sheets("Besetzung").Cells(zzzzzz, 2).Value = wert99
Sheets("s").Range("j2:cc81").Replace What:=wert99, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=Truefcb = 0
b:
Loop
sortierenKF_M.ErsatzKF
Range("a1").Select
End Sub&lt/pre&gt
~f~
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
NEUER CODE: :)
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
~f~
&ltpre&gt
Sub sortierenKF()
'
' Makro1 Makro
' Makro am 11.07.2003 von Karsten Jung aufgezeichnet
'
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
Range("a1").Select
For cc = 1 To 80
If Sheets("Mitarbeiter").Cells(cc, 2) = "" Then Exit For
wert3 = Sheets("Mitarbeiter").Cells(cc, 2)
For xx = 3 To 45 Step 3
masch = Sheets("Mitarbeiter").Cells(cc, xx): pri = Sheets("Mitarbeiter").Cells(cc, xx + 1)
If masch = "" Then masch = Sheets("Mitarbeiter").Cells(cc, 48): pri = Sheets("Mitarbeiter").Cells(cc, 49): xx = 45: If masch = "" Then Exit For
'Überwachung auf 9 fehlt noch!!!!
Sheets("s").Select
If masch = "SO1" Then fkk = 10
If masch = "SO6" Then fkk = 12
If masch = "SO8" Then fkk = 14
If masch = "QS7 QS-Führer" Then fkk = 16
If masch = "QS7 VP-Führer" Then fkk = 18
If masch = "QS14 QS-Führer" Then fkk = 20
If masch = "QS14 VP-Führer" Then fkk = 22
If masch = "PLS" Then fkk = 24
If masch = "RA2" Then fkk = 26
If masch = "RA5" Then fkk = 28
If masch = "RA5a" Then fkk = 30
If masch = "RA6" Then fkk = 32
If masch = "RA7" Then fkk = 34
If masch = "RA8" Then fkk = 36
If masch = "RA9" Then fkk = 38
If masch = "StaplerQS" Then fkk = 40
If masch = "StaplerFVP" Then fkk = 42
If masch = "Ungeriest" Then fkk = 44
If masch = "Sortierung" Then fkk = 46
If masch = "Retoure" Then fkk = 48
If masch = "QS7 QS-Gehilfe" Then fkk = 50
If masch = "QS7 VP-Gehilfe" Then fkk = 52
If masch = "QS14 QS-Gehilfe" Then fkk = 54
If masch = "QS14 VP-Gehilfe" Then fkk = 56
If fkk = "" Then Mldg = "Sie haben bei ---&gt" + wert3 + " &lt--- eine unbekannte Maschine eingegeben, bitte baldmöglichst überprüfen!!! ---&gt " + masch + " &lt--- gibt es nicht oder ist falsch geschrieben (Ein Leerzeichen wo keins hingehört?)" ' Meldung definieren.
If fkk = "" Then Stil = vbOKOnly + vbCritical
If fkk = "" Then Titel = "Falsche Maschine bei " + wert3 ' Titel definieren.
If fkk = "" Then Antwort = MsgBox(Mldg, Stil, Titel) ' Meldung anzeigen.
For gg = 2 To 80
If Cells(gg, fkk).Value = "" Then Cells(gg, fkk).Value = wert3: Cells(gg, fkk + 1).Value = pri: fkk = "": gg = 80
Next gg
If pri = "9" Then
For lern = 1 To 80:
If Cells(lern, 3).Value = "" Then Cells(lern, 3) = wert3: Cells(lern, 4) = masch: Range("j2:be81").Replace What:=wert3, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=Truefcb = 0: lern = 80
Next lern
End If
Next xx
Next cc
Sheets("S").Select
Range("j2:k81").Sort Key1:=Range("k2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("l2:m81").Sort Key1:=Range("m2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("n2:o81").Sort Key1:=Range("o2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("p2:q81").Sort Key1:=Range("q2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("r2:s81").Sort Key1:=Range("s2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("t2:u81").Sort Key1:=Range("u2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("v2:w81").Sort Key1:=Range("w2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("x2:y81").Sort Key1:=Range("y2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("z2:aa81").Sort Key1:=Range("aa2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ab2:ac81").Sort Key1:=Range("ac2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ad2:ae81").Sort Key1:=Range("ae2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("af2:ag81").Sort Key1:=Range("ag2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ah2:ai81").Sort Key1:=Range("ai2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("aj2:ak81").Sort Key1:=Range("ak2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("al2:am81").Sort Key1:=Range("am2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("an2:ao81").Sort Key1:=Range("ao2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ap2:aq81").Sort Key1:=Range("aq2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ar2:as81").Sort Key1:=Range("as2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("at2:au81").Sort Key1:=Range("au2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("av2:aw81").Sort Key1:=Range("aw2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("ax2:ay81").Sort Key1:=Range("ay2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("az2:ba81").Sort Key1:=Range("ba2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bb2:be81").Sort Key1:=Range("bc2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bd2:be81").Sort Key1:=Range("be2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
Range("bf2:bg81").Sort Key1:=Range("bg2"), Order1:=xlAscending, header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
'sicherung anlegen
Sheets("s").Range("J2:be81").Copy Destination:=Sheets("s").Range("J100")
sortieren:
wert99 = True: zähler = 0: ' Variablen initialisieren.
Do While zähler &lt 44 ' Länge bestimmen
zähler = zähler + 1 ' Zähler hochzählen.
If zähler = 1 Then zzzz = 14: zzzzzz = 3 ' Attributwert setzen für SO8.
If zähler = 2 Then zzzz = 12: zzzzzz = 2 ' Attributwert setzen für SO6.
If zähler = 3 Then zzzz = 10: zzzzzz = 1 ' Attributwert setzen für SO1.
If zähler = 4 Then zzzz = 20: zzzzzz = 8 ' Attributwert setzen für QS14 1.
If zähler = 5 Then zzzz = 54: zzzzzz = 9 ' Attributwert setzen für QS14 2.
If zähler = 6 Then zzzz = 16: zzzzzz = 4 ' Attributwert setzen für QS7 1.
If zähler = 7 Then zzzz = 50: zzzzzz = 5 ' Attributwert setzen für QS7 2.
If zähler = 8 Then zzzz = 22: zzzzzz = 10 ' Attributwert setzen für QS14 3.
If zähler = 9 Then zzzz = 56: zzzzzz = 11 ' Attributwert setzen für QS14 4.
If zähler = 10 Then zzzz = 18: zzzzzz = 6 ' Attributwert setzen für QS7 3.
If zähler = 11 Then zzzz = 52: zzzzzz = 7 ' Attributwert setzen für QS7 4.
If zähler = 12 Then zzzz = 42: zzzzzz = 32 ' Attributwert setzen für FVP 1.
If zähler = 13 Then zzzz = 42: zzzzzz = 33 ' Attributwert setzen für FVP 2.
If zähler = 14 Then zzzz = 42: zzzzzz = 34 ' Attributwert setzen für FVP 3.
If zähler = 15 Then zzzz = 24: zzzzzz = 12 ' Attributwert setzen für PLS 1.
If zähler = 16 Then zzzz = 24: zzzzzz = 13 ' Attributwert setzen für PLS 2.
If zähler = 17 Then zzzz = 24: zzzzzz = 14 ' Attributwert setzen für PLS 3.
If zähler = 18 Then zzzz = 38: zzzzzz = 26 ' Attributwert setzen für RA9 1.
If zähler = 19 Then zzzz = 38: zzzzzz = 27 ' Attributwert setzen für RA9 2.
If zähler = 20 Then zzzz = 36: zzzzzz = 24 ' Attributwert setzen für RA8 1.
If zähler = 21 Then zzzz = 36: zzzzzz = 25 ' Attributwert setzen für RA8 2.
If zähler = 22 Then zzzz = 34: zzzzzz = 22 ' Attributwert setzen für RA7 1.
If zähler = 23 Then zzzz = 34: zzzzzz = 23 ' Attributwert setzen für RA7 2.
If zähler = 24 Then zzzz = 26: zzzzzz = 15 ' Attributwert setzen für RA2 1.
If zähler = 25 Then zzzz = 26: zzzzzz = 16 ' Attributwert setzen für RA2 2.
If zähler = 26 Then zzzz = 30: zzzzzz = 19 ' Attributwert setzen für RA5a.
If zähler = 27 Then zzzz = 28: zzzzzz = 17 ' Attributwert setzen für RA5 1.
If zähler = 28 Then zzzz = 28: zzzzzz = 18 ' Attributwert setzen für RA5 2.
If zähler = 29 Then zzzz = 32: zzzzzz = 20 ' Attributwert setzen für RA6 1.
If zähler = 30 Then zzzz = 32: zzzzzz = 21 ' Attributwert setzen für RA6 2.
If zähler = 31 Then zzzz = 40: zzzzzz = 28 ' Attributwert setzen für QS 1.
If zähler = 32 Then zzzz = 40: zzzzzz = 29 ' Attributwert setzen für QS 2.
If zähler = 33 Then zzzz = 40: zzzzzz = 30 ' Attributwert setzen für QS 3.
If zähler = 34 Then zzzz = 40: zzzzzz = 31 ' Attributwert setzen für QS 4.
If zähler = 35 Then zzzz = 44: zzzzzz = 35 ' Attributwert setzen für UNG 1.
If zähler = 36 Then zzzz = 44: zzzzzz = 36 ' Attributwert setzen für UNG 2.
If zähler = 37 Then zzzz = 44: zzzzzz = 37 ' Attributwert setzen für UNG 3.
If zähler = 38 Then zzzz = 44: zzzzzz = 38 ' Attributwert setzen für UNG 4.
If zähler = 39 Then zzzz = 46: zzzzzz = 39 ' Attributwert setzen für SOR 1.
If zähler = 40 Then zzzz = 46: zzzzzz = 40 ' Attributwert setzen für SOR 2.
If zähler = 41 Then zzzz = 46: zzzzzz = 41 ' Attributwert setzen für SOR 3.
If zähler = 42 Then zzzz = 48: zzzzzz = 42 ' Attributwert setzen für Retoure.
If zähler = 43 Then zzzz = 46: zzzzzz = 44 ' Attributwert setzen für SOR 4.
If zähler = 44 Then zzzz = 24: zzzzzz = 43 ' Attributwert setzen für PLS 4.
For fg = 2 To 80
If Sheets("s").Cells(fg, zzzz) &lt&gt "" Then If Sheets("Besetzung").Cells(zzzzzz, 2).Value = "" Then Sheets("Besetzung").Cells(zzzzzz, 2).Value = Sheets("s").Cells(fg, zzzz): fg = 80: _
Sheets("s").Range("j2:cc81").Replace What:=Sheets("Besetzung").Cells(zzzzzz, 2).Value, Replacement:="", LookAt:=xlWhole, SearchOrder:=xlByColumns, MatchCase:=Truefcb = 0
Next fg
Loop
sortierenKF_M.ErsatzKF
Range("a1").Select
End Sub&lt/pre&gt
Was sagst du?
MfG
KaJu
Anzeige
AW: wie sieht das jetzt aus?
P@ulchen
Hi Karsten,
es wäre sinnvoller, wenn man mel eine Beispieldatei sehen könnte, damit man erkennen kann, was Du eigentlich tun willst.
Für die Zuweisung der Attributwerte würde ich eine separate Tabelle (Data) nutzen und die Sortierungen der Spalten kann man auch durch eine Schleife realisieren:
Gruß aus Leipzig
P@ulchen
Das Forum lebt auch von den Rückmeldungen !
AW: wie sieht das jetzt aus?
18.10.2004 15:25:53
KaJu
Hi
Sende mir mal deine E-Mailadresse, dann schicke ich dir das Programm mal zu, aber erschreck dich nicht.
Meine ist
karsten.jung@ewetel.net
MfG
KaJu
Anzeige
geschlossen
P@ulchen

63 Forumthreads zu ähnlichen Themen

Alle Zellen mit Kommentaren farblich markieren
Ralph P.

Hallo.
Ich möchte in einer Excel-Tabelle alle Zellen farblich markieren, die einen Komentar enthalten. Mein Ansatzt ist dieser:Sub mark()laRow = Cells(Rows.Count, 1).End(xlUp).Row
laCol = Cells(Columns.Count).End(xlToLeft).Column
For col = 1 To laCol For Row = 1 To laRow
Cell...
29.04.2002 11:46:36
Thread-ID: 117105
4 Beiträge
Anzeige
Alle nicht leeren Zellen der Spalte C markieren
Marco

Hallo,
in der Spalte C befinden sich unter einander weg Zahlenwerte. ich möchte nun alle Zellen dieser Spalte markieren, die nicht leer sind.
Kann mir Jemand helfen?
Vielen Dank im Voraus.
LG Marco
31.07.2014 08:02:24
Thread-ID: 1373282
4 Beiträge
Alle Zeilen mit Eintrag markieren (ab Zeile 10)
Schulle

Hallo Leute,
ich hoffe, ihr könnt mir helfen. Gibt es eine Möglichkeit ab Zeile 10 alle Zeilen zu markieren, bei denen in Spalte 1 ein Eintrag enthalten ist. Währe mir wichtig um diese Zeilen manuell schnell in in ein anderes Tabellenblatt kopieren zu können. Ist nämlich manchmal ganz schön...
25.05.2015 12:23:18
Thread-ID: 1427638
3 Beiträge
Anzeige
VBA alle gefundenen Zellen markieren
Andreas

Hallo Excelfreunde,
Ich bin hier schon des Öfteren gut geholfen worden.
Ich benötige mal wieder professionelle Hilfe.
folgendes Problem:
In diesem Makro wird in Tabelle 1 ab Zeile 10 nach dem gefundenen Wert in Tabell1!A1 (frei definiert) gesucht. Alle gefundenen Werte werden da...
08.11.2016 08:33:06
Thread-ID: 1523614
6 Beiträge
Alle (nur) Zellen mit Inhalt markieren
Daniel Köchler

Hallo,ich brauche ein Makro, mit dem ich alle Zellen, die einen Inhalt haben, markieren!Daniel
05.11.2002 18:10:01
Thread-ID: 177523
2 Beiträge
alle nicht gesperrten Zellen markieren
Tanja

Hallo Profis,

ich würde gerne mit einem Klick alle nicht gesperrten Zellen in einer Tabelle markieren können, so dass ich überprüfen kann, ob in allen notwendigen Zellen die Sperrung aufgehoben ist und ich sie dann farblich vom Rest der Tabelle absetzen kann.

Ich bin leider noch...
11.07.2003 12:09:21
Thread-ID: 279784
8 Beiträge
Alle Zellen mit Jahr 2004 markieren
Frank
Hallo,

ich möchte alle Zellen der Spalte A markieren, die im Jahr 2004 liegen.
Wobei alle Zellen in Spalte A im Datumformat vorliegen.
Wie krieg ich das hin?

Danke
25.09.2003 12:42:28
Thread-ID: 315067
8 Beiträge
Alle Zellen bis auf erste Zeile markieren mit VBA
der alex
Hallo!
Wie kann ich am einfachsten alle Zellen eines Tabellenblattes ausschließlich der ersten Zeile mit VBA markieren/kopieren?
danke!

der alex
08.06.2004 11:36:41
Thread-ID: 438724
3 Beiträge
Anzeige

Links zu Excel-Dialogen

ComboBox

Beliebteste Forumthreads (12 Monate)

Anzeige
Jetzt das Excel-Portal bewerten: Deine Stimme zählt!

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige
Archiv - Verwandte Themen
Forumthread
Beiträge
3
21
3
2
10
5
1
7
7
2
6
2
1
17
1
5
13
1
6
10
4
2
7
8
3