AW: Sheets Range Cells
06.03.2015 13:54:19
Christian
Oh jetzt wird es peinlich aber ok
Private Sub CommandButton1_Click()
Dim lRow As Long, lCol As Long
Dim index As Integer, i As Integer, lauf As Integer, test As Integer
Dim sItem1 As String
Dim sItem2 As String
Dim sItem3 As String
Dim iSPos1 As Integer
Dim iSPos2 As Integer
Dim iSPos3 As Integer
lCol = 1 'Spalte
lRow = 1 'StartZeile
Do While Cells(lRow, lCol).Value ""
sItem1 = Cells(lRow, 1).Value
iSPos1 = InStr(sItem1, vbLf)
sItem2 = Cells(lRow, 2).Value
iSPos2 = InStr(sItem2, vbLf)
sItem3 = Cells(lRow, 3).Value
iSPos3 = InStr(sItem3, vbLf)
If iSPos1 > 0 Then
Rows(lRow + 1).Insert shift:=xlDown
Cells(lRow, 1) = Left(sItem1, iSPos1 - 1)
Cells(lRow + 1, 1) = Mid(sItem1, iSPos1 + 1)
End If
If iSPos2 > 0 Then
Cells(lRow, 2) = Left(sItem2, iSPos2 - 1)
Cells(lRow + 1, 2) = Mid(sItem2, iSPos2 + 1)
End If
If iSPos3 > 0 Then
Cells(lRow, 3) = Left(sItem3, iSPos3 - 1)
Cells(lRow + 1, 3) = Mid(sItem3, iSPos3 + 1)
End If
lRow = lRow + 1
Loop
lCol = 1 'Spalte
lRow = 1 'StartZeile
index = 3
j = 1
test = 0
For i = 1 To 2000
If Cells(i, 4) "" Then
Sheets("Tabelle1").Cells(1, index) = Cells(i, 4)
Sheets("Tabelle1").Cells(2, index) = Cells(i, 5)
Do While ((Cells(j, 4) = "" Or Cells(j, 4) = Sheets("Tabelle1").Cells(1, index)) _
And Cells(j, 1) "")
For lauf = 1 To 40
If (Sheets("Tabelle1").Cells(lauf, 2) = Cells(j, 1) And test 1) Then
Sheets("Tabelle1").Cells(lauf, index) = Cells(j, 2)
Sheets("Tabelle1").Cells(lauf + 1, index) = Cells(j, 3)
test = 1
End If
Next lauf
test = 0
j = j + 1
Loop
index = index + 2
End If
Next i
i = 3
Do While Sheets("Tabelle1").Range(Cells(1, i), Cells(1, i + 20)) ""
j = 1
Do While Sheets("14.12.-14.09.15+23.10.-12.12.15").Range(Cells(48, j), Cells(48, j + 20) _
) ""
If (Sheets("Tabelle1").Cells(1, i) = Sheets("14.12.-14.09.15+23.10.-12.12.15"). _
Cells(48, j) And Cells(1, i) "") Then
Sheets("Tabelle1").Range(Cells(1, i), Cells(33, i)).Select
Selection.Cut
Sheets("Tabelle1").Range(Cells(36, i), Cells(68, i)).Select
Selection.Paste
j = j + 1
End If
Loop
i = i + 1
Loop
End Sub