- Katılım
- 14 Ağustos 2008
- Mesajlar
- 82
- Excel Vers. ve Dili
- 2003 - english
Aşağıdaki if then elsemde bir sorun var. A sütunundaki Sayfa: yazan veya boş olan veya içinde tarih yer alan hücrelere geldiğinde atlamasını sitiyorum. Tarihte işe yarıyor ama Sayfa: ve boş hücrelerde işe yaramıyor, hatamı bulamıyorum.
Sub DENE()
Application.ScreenUpdating = False
Dim i, slu, slr, slf, k, tmp, tmb, m, l, b As Integer
Dim r As Boolean
Dim harf(28) As String
harf(1) = "A"
harf(2) = "B"
harf(3) = "C"
harf(4) = "D"
harf(5) = "E"
harf(6) = "F"
harf(7) = "G"
harf(8) = "H"
harf(9) = "I"
harf(10) = "J"
harf(11) = "K"
harf(12) = "L"
harf(13) = "M"
harf(14) = "N"
harf(15) = "O"
harf(16) = "P"
harf(17) = "Q"
harf(18) = "R"
harf(19) = "S"
harf(20) = "T"
harf(21) = "U"
harf(22) = "V"
harf(23) = "W"
harf(24) = "Y"
harf(25) = "Z"
harf(26) = "AA"
harf(27) = "AB"
harf(28) = "AC"
Sheets("Sheet2").Select
slu = 1
For i = 1 To 7000
Range("A" & i).Select
Select Case ActiveCell.Value
Case "ÜRÜN:"
Range("G" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("B" & slu)
slr = slu + 3
slf = slu + 2
Sheets("Sheet2").Select
Range("B" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slu)
slu = slu + 17
Sheets("Sheet2").Select
Range("O" & i).Select
Selection.Copy
Selection.Copy Destination:=Sheets("Sheet1").Range("L" & slf)
Sheets("Sheet2").Select
Range("A" & i).Select
Case "Renk"
tmp = slr
tmb = slr
k = i + 1
m = 2
l = i
b = 2
Do While Cells(k, 1) <> "TOPLAM"
If ActiveCell.Value = 0 Then
k = k + 1
ElseIf IsDate(Left(Range("A" & k).Value, 10)) Then
k = k + 1
ElseIf ActiveCell.Value = "Sayfa:" Then
k = k + 1
Else
Sheets("Sheet1").Cells(tmp, 1) = Range("A" & k).Value
tmp = tmp + 1
k = k + 1
End If
Loop
Do While Cells(l, b) <> "TOPLAM"
Sheets("Sheet1").Cells(tmb, b) = Range(harf(b) & l).Value
b = b + 1
m = m + 1
Loop
End Select
Next i
End Sub