Zeile kopieren wenn zelle

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hallo Sepp,
danke, habs gleich ausprobiert funktioniert super. Der Zellbereich geht nun von A bis AB und die Zelle mit den Namen ist I. Dein Makro hab ich daraufhin angepasst (das kann ich ja ;-) und es funktioniert. Was ich falsch angegeben habe ist, die Namen sind durch ; und ein Leerzeichen getrennt, daher stehen in den Zellen I alle weiteren Namen mit einem führenden Leerzeichen drinnen. Kann man das gleich ins Makro einbauen damit man nicht Glätten muss?
Hier noch das von mir angepasste Makro.

Sub splitNames()
Dim vntValues As Variant, vntTmp As Variant, vntNew() As Variant
Dim lngIndex As Long, lngN As Long, lngC As Long, lngM As Long
With ActiveSheet
vntValues = .Range("A2:AB" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For lngIndex = 1 To UBound(vntValues, 1)
If InStr(1, vntValues(lngIndex, 9), "; ") = 0 Then
lngN = lngN + 1
ReDim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
For lngC = 1 To UBound(vntValues, 2)
vntNew(lngC, lngN) = vntValues(lngIndex, lngC)
Next
Else
vntTmp = Split(vntValues(lngIndex, 9), "; ")
For lngM = 0 To UBound(vntTmp)
lngN = lngN + 1
ReDim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
For lngC = 1 To UBound(vntValues, 2)
vntNew(lngC, lngN) = IIf(lngC = 9, vntTmp(lngM), vntValues(lngIndex, lngC))
Next
Next
End If
Next
vntNew = Application.Transpose(vntNew)
.Range("A2").Resize(UBound(vntNew, 1), UBound(vntNew, 2)) = vntNew
End With
End Sub

Gruß
Michael

Hallo Michael,
da hilft "Trim()".

Sub splitNames()
  Dim vntValues As Variant, vntTmp As Variant, vntNew() As Variant
  Dim lngIndex As Long, lngN As Long, lngC As Long, lngM As Long

  With ActiveSheet
    vntValues = .Range("A2:AB" & .Cells(.Rows.Count, 1).End(xlUp).Row)
    For lngIndex = 1 To UBound(vntValues, 1)
      If InStr(1, vntValues(lngIndex, 9), "; ") = 0 Then
        lngN = lngN + 1
        Redim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
        For lngC = 1 To UBound(vntValues, 2)
          vntNew(lngC, lngN) = vntValues(lngIndex, lngC)
        Next
      Else
        vntTmp = Split(vntValues(lngIndex, 9), ";")
        For lngM = 0 To UBound(vntTmp)
          lngN = lngN + 1
          Redim Preserve vntNew(1 To UBound(vntValues, 2), 1 To lngN)
          For lngC = 1 To UBound(vntValues, 2)
            vntNew(lngC, lngN) = IIf(lngC = 9, Trim$(vntTmp(lngM)), vntValues(lngIndex, lngC))
          Next
        Next
      End If
    Next
    vntNew = Application.Transpose(vntNew)
    .Range("A2").Resize(UBound(vntNew, 1), UBound(vntNew, 2)) = vntNew

  End With
End Sub

Gruß Sepp

Beliebteste Forumthreads (12 Monate)

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread