Thema Datum  Von Nutzer Rating
Antwort
27.05.2019 16:17:45 Nicole
NotSolved
27.05.2019 16:22:28 Gast79255
NotSolved
27.05.2019 16:28:47 Gast12617
NotSolved
27.05.2019 18:22:04 Gast39786
NotSolved
28.05.2019 09:48:38 Nicole
NotSolved
Blau doppelte Datensätze in nicht nebeinander stehenden Zeilen entfernen
28.05.2019 11:13:05 Gast39786
NotSolved

Ansicht des Beitrags:
Von:
Gast39786
Datum:
28.05.2019 11:13:05
Views:
432
Rating: Antwort:
  Ja
Thema:
doppelte Datensätze in nicht nebeinander stehenden Zeilen entfernen

Auch ich nehme zum Zählen der Spalten und der  .Offset's-Sprünge immer die Finger zu Hilfe  ;-)

Sub DatenvorbereitungRAGReporting()
Dim x As Long, c As Range, fc As String, sm As Double, flag As Boolean, z As Long
 
   '_____________
   'Ziel anpassen
   With Sheets("Ausgabesheet")
      On Error Resume Next
      z = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row
      On Error GoTo 0
   End With
   '_____________
    
   'Quelle anpassen
   With Sheets("Daten Stunden")
      'Suche letzte Zeile immer ab .Cells(1)
      For x = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row To 1 Step -1
         If .Cells(x, 9).Value <> "" Then
            fc = .Cells(x, 9).Address: sm = .Cells(x, 11).Value: flag = False
            Set c = .Columns(9).Find(.Cells(x, 9).Value, .Cells(x, 9), xlValues, xlWhole, 2, 1)
            If Not c Is Nothing And c.Address <> fc Then
               Do
                  If c.Offset(, 4) = .Cells(x, 13) Then
                     sm = sm + c.Offset(, 2).Value: flag = True
                     c.Resize(, 11).ClearContents
                  End If
                  Set c = .Columns(9).FindNext(c)
               Loop While Not c Is Nothing And c.Address <> fc
            End If
         End If
         If flag Then
            .Cells(x, 11).Value = sm
            z = z + 1
            '_____________
            'Ziel anpassen
            .Cells(x, 9).Resize(, 11).Copy Sheets("Ausgabesheet").Cells(z, 9)
            .Cells(x, 9).Resize(, 11).ClearContents
         End If
         flag = False
      Next x
      '_________
      'wahlfrei
      On Error GoTo Nix
      For x = .Cells.Find("*", .Cells(1), -4123, 2, 1, 2, False).Row To 1 Step -1
         If .Cells(x, 9).Value = "" Then .Rows(x).Delete
      Next x
      On Error GoTo 0
      '_________
Nix:
   End With
 
End Sub

 


Ihre Antwort
  • 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: Name: Email:



  • 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
27.05.2019 16:17:45 Nicole
NotSolved
27.05.2019 16:22:28 Gast79255
NotSolved
27.05.2019 16:28:47 Gast12617
NotSolved
27.05.2019 18:22:04 Gast39786
NotSolved
28.05.2019 09:48:38 Nicole
NotSolved
Blau doppelte Datensätze in nicht nebeinander stehenden Zeilen entfernen
28.05.2019 11:13:05 Gast39786
NotSolved