ikikan
Altın Üye
- Katılım
- 3 Mart 2009
- Mesajlar
- 519
- Excel Vers. ve Dili
- excel 2003 tr
- Altın Üyelik Bitiş Tarihi
- 12.02.2026
Arkadaşlar altaki kodlamada for next yerine ne kullanabilirim ?
örnek dosya ektedir...
örnek dosya ektedir...
Sub PROJE4()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
'Application.Volatile
Dim ss1, ss2, ss3, ss4, bitis, say, b, c, e, f, j, g, h, t, l, y, s, k As Integer
Dim d0() As Double
Dim d1() As Double
Dim d2() As Double
Dim d3() As Double
Dim d4() As Double
Dim d5() As Double
Dim d6() As Double
Dim d7() As Double
Dim k0() As Double
Dim b0() As Double
Dim b1() As Double
Dim Sonuc As String
Dim a, x As Long
Dim Bsl0, Bsl1, Bsl2, Bsl3, Bsl4, Bsl5, Bsl6, Bsl7, Bsl8, Bsl9 As Variant
Dim Snc0, Snc1, Snc2, Snc3, Snc4, Snc5, Snc6, Snc7, Snc8, Snc9 As Variant
Dim Tnl0, Tnl1, Tnl2, Tnl3, Tnl4, Tnl5, Tnl6, Tnl7, Tnl8, Tnl9 As Variant
Dim Ynl0, Ynl1, Ynl2, Ynl3, Ynl4, Ynl5, Ynl6, Ynl7, Ynl8, Ynl9 As Variant
Dim Max0, Max1, Max2, Max3, Max4, Max5, Max6, Max7, Max8, Max9 As Variant
Dim Maxv0, Maxb0 As Variant
Dim i, m, n, s1, Brl0, Brl1, Brl2, Brl3, a1, a2, a3, sut, str, Baslık
Dim shf1, shf2, sh As Worksheet
Dim hucre, hucre1, hucre2, Veri1 As Range
Dim Br0, Br1, Br2, Br3, Br4, Br5, Br6, Br7
Dim Kr0, Kr1, Kr2, Kr3, Kr4, Kr5, Kr6, Kr7
Dim Tr0, Tr1, Tr2, Tr3, Tr4, Tr5, Tr6, Tr7
Dim shf3 As String
Set shf1 = Sheets("PROJE1")
Set sh = Sheets("veri")
If UserForm1.ListBox2.ListIndex < 0 Then
MsgBox "LÜTFEN VERİ TABANI VE KATAGORİ SEÇİN..!!", vbCritical
Exit Sub
End If
'str = shf1.Cells(Rows.Count, "A").End(3).row
'shf1.Range("A3" & ":HA" & str).ClearContents
'shf1.Range("B:IV").ClearContents
If UserForm1.ListBox1.ListIndex = 0 Then
a = 71
Else
a = 0
End If
For e = 1 To UserForm1.ListView1.ColumnHeaders.Count - (1 + a)
For i = 1 To UserForm1.ListView1.ListItems.Count
If UserForm1.ListView1.ListItems(i).Selected = True Then
ReDim Preserve d1(i)
d1(i) = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e))
On Error Resume Next
End If
Next i
Brl1 = ""
Brl0 = ""
For i = 1 To UserForm1.ListView1.ListItems.Count
If UserForm1.ListView1.ListItems(i).Selected = True Then
If UserForm1.CheckBox1.Value = True Then
Snc0 = Len(UserForm1.ListView1.ColumnHeaders((e + 1)))
Else
Snc0 = 0
End If
Snc1 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e))
Snc2 = Application.WorksheetFunction.Max(d1, Snc0)
Ynl0 = WorksheetFunction.Rept("_", (Snc2 - Snc1))
Ynl1 = WorksheetFunction.Rept("_", (Snc2 - Snc0))
If UserForm1.ListBox1.ListIndex = 0 Then
Brl1 = Brl1 & Ynl0 & UserForm1.ListView1.ListItems(i).ListSubItems(e) & "*" & vbLf
Else
Brl1 = Brl1 & UserForm1.ListView1.ListItems(i).ListSubItems(e) & Ynl0 & "*" & vbLf
End If
Brl0 = UserForm1.ListView1.ColumnHeaders((e + 1)) & "*" & Ynl1 & vbLf
If UserForm1.CheckBox1.Value = True Then
Baslık = Brl0
Else
End If
shf1.Cells(e + 1, 2).Value = Baslık & Brl1
End If
Next i
Next e
'...................................................................................................................
If UserForm1.ListBox1.ListIndex = 0 Then
For i = 0 To UserForm1.ListView1.ListItems.Count
If UserForm1.ListView1.ListItems(i).Selected = True Then
Tr0 = ""
Tr1 = ""
Tr2 = ""
Tr3 = ""
Tr4 = ""
Tr5 = ""
Tr6 = ""
Tr7 = ""
Br0 = ""
Br1 = ""
Br2 = ""
Br3 = ""
Br4 = ""
Br5 = ""
Br6 = ""
Br7 = ""
For e = 48 To 56
For n = 0 To UserForm1.ListView1.ListItems.Count
If UserForm1.ListView1.ListItems.Selected = True Then
ReDim Preserve d0
d0
d1
d2
d3
d4
d5
d6
d7
b0
b1
On Error Resume Next
End If
Next n
Bsl0 = Len(UserForm1.ListView1.ColumnHeaders((e + 1)))
Bsl1 = Len(UserForm1.ListView1.ColumnHeaders((e + 10)))
Bsl2 = Len(UserForm1.ListView1.ColumnHeaders((e + 19)))
Bsl3 = Len(UserForm1.ListView1.ColumnHeaders((e + 28)))
Bsl4 = Len(UserForm1.ListView1.ColumnHeaders((e + 37)))
Bsl5 = Len(UserForm1.ListView1.ColumnHeaders((e + 46)))
Bsl6 = Len(UserForm1.ListView1.ColumnHeaders((e + 55)))
Bsl7 = Len(UserForm1.ListView1.ColumnHeaders((e + 64)))
Snc0 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 0))
Snc1 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 9))
Snc2 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 18))
Snc3 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 27))
Snc4 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 36))
Snc5 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 45))
Snc6 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 54))
Snc7 = Len(UserForm1.ListView1.ListItems(i).ListSubItems(e + 63))
Max0 = Application.WorksheetFunction.Max(d0, Snc0, Bsl0)
Max1 = Application.WorksheetFunction.Max(d1, Snc1, Bsl1)
Max2 = Application.WorksheetFunction.Max(d2, Snc2, Bsl2)
Max3 = Application.WorksheetFunction.Max(d3, Snc3, Bsl3)
Max4 = Application.WorksheetFunction.Max(d4, Snc4, Bsl4)
Max5 = Application.WorksheetFunction.Max(d5, Snc5, Bsl5)
Max6 = Application.WorksheetFunction.Max(d6, Snc6, Bsl6)
Max7 = Application.WorksheetFunction.Max(d7, Snc7, Bsl7)
Tnl0 = WorksheetFunction.Rept("_", (Max0 - Bsl0))
Tnl1 = WorksheetFunction.Rept("_", (Max1 - Bsl1))
Tnl2 = WorksheetFunction.Rept("_", (Max2 - Bsl2))
Tnl3 = WorksheetFunction.Rept("_", (Max3 - Bsl3))
Tnl4 = WorksheetFunction.Rept("_", (Max4 - Bsl4))
Tnl5 = WorksheetFunction.Rept("_", (Max5 - Bsl5))
Tnl6 = WorksheetFunction.Rept("_", (Max6 - Bsl6))
Tnl7 = WorksheetFunction.Rept("_", (Max7 - Bsl7))
Ynl0 = WorksheetFunction.Rept("_", (Max0 - Snc0)) ' DÜZELT
Ynl1 = WorksheetFunction.Rept("_", (Max1 - Snc1)) ' DÜZELT
Ynl2 = WorksheetFunction.Rept("_", (Max2 - Snc2)) ' DÜZELT
Ynl3 = WorksheetFunction.Rept("_", (Max3 - Snc3)) ' DÜZELT
Ynl4 = WorksheetFunction.Rept("_", (Max4 - Snc4)) ' DÜZELT
Ynl5 = WorksheetFunction.Rept("_", (Max5 - Snc5)) ' DÜZELT
Ynl6 = WorksheetFunction.Rept("_", (Max6 - Snc6)) ' DÜZELT
Ynl7 = WorksheetFunction.Rept("_", (Max7 - Snc7)) ' DÜZELT
If Application.WorksheetFunction.Or(b0) = False Then
Else
Tr0 = Tr0 & UserForm1.ListView1.ColumnHeaders((e + 1)) & "__" & Tnl0
Br0 = Br0 & Ynl0 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 0) & "__"
End If
If Application.WorksheetFunction.Or(b1) = False Then
Else
Tr1 = Tr1 & UserForm1.ListView1.ColumnHeaders((e + 10)) & "__" & Tnl1
Tr2 = Tr2 & UserForm1.ListView1.ColumnHeaders((e + 19)) & "__" & Tnl2
Tr3 = Tr3 & UserForm1.ListView1.ColumnHeaders((e + 28)) & "__" & Tnl3
Tr4 = Tr4 & UserForm1.ListView1.ColumnHeaders((e + 37)) & "__" & Tnl4
Tr5 = Tr5 & UserForm1.ListView1.ColumnHeaders((e + 46)) & "__" & Tnl5
Tr6 = Tr6 & UserForm1.ListView1.ColumnHeaders((e + 55)) & "__" & Tnl6
Tr7 = Tr7 & UserForm1.ListView1.ColumnHeaders((e + 64)) & "__" & Tnl7
Br1 = Br1 & Ynl1 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 9) & "__"
Br2 = Br2 & Ynl2 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 18) & "__"
Br3 = Br3 & Ynl3 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 27) & "__"
Br4 = Br4 & Ynl4 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 36) & "__"
Br5 = Br5 & Ynl5 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 45) & "__"
Br6 = Br6 & Ynl6 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 54) & "__"
Br7 = Br7 & Ynl7 & UserForm1.ListView1.ListItems(i).ListSubItems(e + 63) & "__"
End If
Next e
Kr0 = Kr0 & Br0 & vbLf
Kr1 = Kr1 & Br1 & vbLf
Kr2 = Kr2 & Br2 & vbLf
Kr3 = Kr3 & Br3 & vbLf
Kr4 = Kr4 & Br4 & vbLf
Kr5 = Kr5 & Br5 & vbLf
Kr6 = Kr6 & Br6 & vbLf
Kr7 = Kr7 & Br7 & vbLf
shf1.Cells(50, 2).Value = Tr0 & Kr0
shf1.Cells(51, 2).Value = Tr1 & Kr1
shf1.Cells(52, 2).Value = Tr2 & Kr2
shf1.Cells(53, 2).Value = Tr3 & Kr3
shf1.Cells(54, 2).Value = Tr4 & Kr4
shf1.Cells(55, 2).Value = Tr5 & Kr5
shf1.Cells(56, 2).Value = Tr6 & Kr6
shf1.Cells(56, 2).Value = Tr7 & Kr7
End If
Next i
Else
End If
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub