Microsoft Excel

Herbers Excel/VBA-Archiv

Bewerten Sie hier bitte das Excel-Portal

Der kurze Weg zum Ziel: Auftragsprogrammierung

VBA Liste in Tabelle1 eintragen Tabelle2 bereinigen

nach unten

Betrifft: VBA Liste in Tabelle1 eintragen Tabelle2 bereinigen von: Sedat
Geschrieben am: 03.10.2020 01:05:16

Hallo Freunde,


Bei der Abarbeitung der Täglichen Punkte Liste, können wir nur per Zeilen Angabe die Werte Eintragen.

Wir würden es Gerne Per VBA Schleife die Liste einfach durchlaufen lassen, bekommen es aber nicht hin.

kann uns jemand behilflich sein.


am Beispiel sehen sie es funktioniert wenn wir z.B die Zeile 4 in die Zelle eintrage und den VBA macro starten wird es eingetragen und gesäubert.

nur bei dem Versuch uber eine Schlefe sind wir getolpert. grinz.


Bitten um Hilfe?



der File ist 400 KB gross konnte es nicht kleiner machen. daher ein Google Drive Link.


Am Beispiel,

https://drive.google.com/file/d/1AjS2fIwMQInfavKVktS3rVgvbZvVw_rM/view?usp=sharing





' ---

Sub Eintragung_Schleife()
Dim Zelle As Range
Dim a As Long
    a = 4                               'Start Zeile

With Worksheets("SpielReport")
    
    For Each Zelle In .Range("P4:P10")  ' Alle Zeilen die "OK" beinhalten Range(P4:P3000)
      If Zelle = "OK" Then
           With ActiveCell
'
' ---- Start Loop und Eintragen -----
'

 Dim aktZeile, vglZeile, vglSpalte As Integer
  vglZeile = Cells(a, 18) 'Spalte R
  vglZeile2 = Cells(a, 19) 'Spalte S
  vglSpalte = Cells(a, 20) 'Spalte T
  vglSpalte2 = Cells(a, 28) 'Spalte AB
  vglRange = Cells(a, 29)
  
  Wert = Cells(a, 27) 'Spalte AA
  aktZeile = vglZeile

  With ThisWorkbook.Sheets("MMS")
   While .Cells(aktZeile, vglSpalte) <> ""
     aktZeile = aktZeile + 1
   Wend
    .Cells(aktZeile, vglSpalte) = Cells(a, 27) 'Spalte AA
    .Cells(aktZeile, vglSpalte + 11) = Cells(a, 24) 'Spalte X
    .Cells(aktZeile, vglSpalte + 22) = Cells(a, 23) 'Spalte W
   End With

    Dim FindString As String
    Dim rng As Range
    FindString = Wert
    If Trim(FindString) <> "" Then
        With Sheets("MMS").Range(vglRange)   'Sheet spalte Cells(a, Q) .Range($AF$14:$AF$15)  _
Spalte Z
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                rng = ""  ' Wert löschen innerhalb der .Range $AF$14:$AF$15)

            Else
              '
            End If
        End With
    End If


'
' ---- Ende Eintrag Ende Loop -----
'
           End With
           a = a + 1
      End If
    Next
End With

End Sub



'---


Lieben Gruss

nach oben  nach unten

Betrifft: AW: VBA Liste in Tabelle1 eintragen Tabelle2 bereinigen
von: ralf_b
Geschrieben am: 03.10.2020 01:58:32

Sub Eintragung_Schleife()
Dim Zelle As Range
Dim a As Long
    a = 4                               'Start Zeile
Dim aktZeile, vglZeile, vglSpalte As Integer


    
 For Each Zelle In Worksheets("SpielReport").Range("P4:P10")   ' Alle Zeilen die "OK"  _
beinhalten Range(P4:P3000)
      If Zelle = "OK" Then
          
'
' ---- Start Loop und Eintragen -----
'
  a = Zelle.Row
 
  vglZeile = Cells(a, 18) 'Spalte R
  vglZeile2 = Cells(a, 19) 'Spalte S
  vglSpalte = Cells(a, 20) 'Spalte T
  vglSpalte2 = Cells(a, 28) 'Spalte AB
  vglRange = Cells(a, 29)
  
  Wert = Cells(a, 27) 'Spalte AA
  aktZeile = vglZeile

  With ThisWorkbook.Worksheets(Cells(a, "Q").Value)
   While .Cells(aktZeile, vglSpalte) <> ""
     aktZeile = aktZeile + 1
   Wend
    .Cells(aktZeile, vglSpalte) = Cells(a, 27) 'Spalte AA
    .Cells(aktZeile, vglSpalte + 11) = Cells(a, 24) 'Spalte X
    .Cells(aktZeile, vglSpalte + 22) = Cells(a, 23) 'Spalte W
   End With

    Dim FindString As String
    Dim rng As Range
    FindString = Wert
    If Trim(FindString) <> "" Then
        With Sheets(Cells(a, "Q").Value).Range(vglRange)   'Sheet spalte Cells(a, Q) .Range($AF$ _
14:$AF$15) Spalte Z
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
                rng = ""  ' Wert löschen innerhalb der .Range $AF$14:$AF$15)

            Else
              '
            End If
        End With
    End If


'
' ---- Ende Eintrag Ende Loop -----
'
      End If
    Next

End Sub


nach oben  nach unten

Betrifft: AW: VBA Liste in Tabelle1 eintragen Tabelle2 bereinigen
von: Sedat
Geschrieben am: 03.10.2020 10:38:58

Hallo ralf_b,

Super Grossen Dank für die schnelle Hilfe,
Jetzt Funktioniert die schleife fast so wie gewünscht.
musste die .Cells(aktZeile, vglSpalte + 1) = Cells(a, 27)
+1 hinzufügen.

Neues Problem, es bereinigt nicht die Doppelten Werte in den Zeilen und Spalten.
Die Werte aus der Zeile dürfen nur einmal in der Range zein.
falls an der Zeile ein Andere Wert zuvor eingetragen war soll es in der Zeile Eingetragen werden was noch leer ist

z.B. Der Zweite Wert aus der Quelle muss nach der Zeile 14 und zwischen 14 und 26 eingetragen werden in die MMB und in der MMS darf innerhalb der gleichen Range entfernt werden.

Das ging vorher auch nicht kannst du uns das auch reinschreiben wenn es keine große umstände macht.

Lieben Gruss

nach oben  nach unten

Betrifft: definiere "keine großen Umstände" .....
von: ralf_b
Geschrieben am: 03.10.2020 11:06:42

Du darfst deine Funktionsbeschreibung gern nochmal überdenken und umformulieren. Und zwar so das Jemand, der davon keine Ahnung hat, dies nachvollziehen kann. Und zwar vollständig.

Du bastelst an Code herum ohne einen Plan(Ahnung) zu haben, weil es ja nicht so schwer sein kann. Und dann werden so wischi washi Angaben gemacht. wie z.b.
"Die Werte aus der Zeile dürfen nur einmal in der Range zein." Welcher Range?

Der Zweite Wert aus der Quelle muss nach der Zeile 14 und zwischen 14 und 26 eingetragen werden in die MMB und in der MMS darf innerhalb der gleichen Range entfernt werden. Hä? Bahnhof!

Du hast es geschafft .Cells(aktZeile, vglSpalte + 1) anzupassen. D.h. du weist zumindest wie man Anpassungen vornimmt. Deshalb nehme ich an das es dir nicht schwer fallen wird die gewünschte Funktionalität durch googlen zusammen zu suchen. z.b. Bereich durchsuchen nach bestimmten Wert Also los. kleiner Tip: sowas steht schon in deiner Schleife drin. Learning by doing!

nach oben  nach unten

Betrifft: AW: definiere "keine großen Umstände" .....
von: Sedat
Geschrieben am: 03.10.2020 11:47:52

Hallo Ralf,

Entschuldige Bitte,
Das ich die ( + 1 ) gefunden habe war reiner zufall, nach der Augenscheinlicher sicht nur Logisch für mich da Zwei weitere (+ 1) angaben nachfolgend sichtbar waren ;-) hab ich es ausprobiert und es ging.

mit der Range war dieser Part:

Dim FindString As String
Dim rng As Range
FindString = Wert
If Trim(FindString) <> "" Then
With Sheets(Cells(a, "Q").Value).Range(vglRange) 'Sheet spalte Cells(a, Q) .Range($AF$ _
14:$AF$15) Spalte Z
Set rng = .Find(What:=FindString, _
After:=.Cells(1), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If Not rng Is Nothing Then
rng = "" ' Werte löschen innerhalb der .Range $AF$14:$AF$15) falls Identisch

Else
'
End If
End With


Ich habe wirklich kein Plan wie es zu machen ist.

Lieben Gruß

nach oben  nach unten

Betrifft: AW: definiere "keine großen Umstände" .....
von: Sedat
Geschrieben am: 03.10.2020 12:15:23


Sorry, mit Löschen meine ich Ändern bzw. erstezen mit ""

rng = "" ' Werte löschen innerhalb der .Range $AF$14:$AF$15) falls Identisch

dieser beitrag kommt der sache näher, wieder kein plan weiss nicht wo einzubinden ist.

https://www.herber.de/forum/archiv/1376to1380/1377417_Suchen_und_Ersetzen_Makro.html