- Katılım
- 18 Şubat 2005
- Mesajlar
- 94
- Excel Vers. ve Dili
- excel 2013 türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
=KAYDIR($A$1;KAÇINCI(SAĞDAN($V$20;4)&" Yılı*";$A:$A;0)+SÜTUN(A1);KAÇINCI(SOLDAN($V$20;BUL(".";$V$20)-1);$B$1:$M$1;0))
Sub bul()
Z = TimeValue(Now)
Set s1 = Sheets("ENDEKS")
Set d = CreateObject("scripting.dictionary")
a = s1.[A1:M36]
For x = 1 To UBound(a) Step 9
For j = 2 To UBound(a, 2)
krt = a(x, j) & "." & Left(a(x, 1), 4)
a(x, j) = krt
d(krt) = d(krt) & a(x, j)
For i = 2 To 8
d(krt) = d(krt) & "|" & a(i + x, j)
Next i
Next j
Next x
a = s1.[V1:Y36].Value2
ReDim b(1 To UBound(a), 1 To 7)
For i = 1 To UBound(a)
say = say + 1
For j = 1 To UBound(a, 2)
If a(i, j) <> "" Then
deg = a(i, j)
ayir = Split(d(deg), "|")
For x = 1 To UBound(ayir)
b(say + 1, x) = ayir(x)
Next x
End If
Next j
Next i
s1.[O1].Resize(say, 7) = b
MsgBox CDate(TimeValue(Now) - Z), vbInformation
End Sub
Sub test()
Set s1 = Sheets("ENDEKS")
a = s1.Range("A1:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim b(1 To UBound(a), 1 To 12)
For i = 1 To UBound(a)
say = say + 1
For j = 2 To UBound(a, 2)
b(say, j - 1) = a(i, j)
If a(i, j) <> "" Then s = s + 1
Next j
If s < 12 Then b(say, s + 1) = a(i, s + 1)
s = 0
Next i
s1.[B1].Resize(say, 12) = b
MsgBox "İşlem tamam.", vbInformation
End Sub

Sub test_1()
Z = TimeValue(Now)
Set s1 = Sheets("ENDEKS")
Set d = CreateObject("scripting.dictionary")
b = s1.Range("A1:M" & s1.Cells(Rows.Count, 1).End(3).Row).Value
ReDim a(1 To UBound(b), 1 To 13)
For i = 1 To UBound(b)
say = say + 1
a(say, 1) = b(i, 1)
For j = 2 To UBound(a, 2)
a(say, j) = b(i, j)
If b(i, j) <> "" Then s = s + 1
Next j
If s < 12 Then a(say, s + 2) = b(i, s + 1)
s = 0
Next i
b = a
For x = 1 To UBound(b) Step 9
For j = 2 To UBound(b, 2)
krt = b(x, j) & "." & Left(b(x, 1), 4)
b(x, j) = krt
d(krt) = d(krt) & b(x, j)
For i = 2 To 8
d(krt) = d(krt) & "|" & b(i + x, j)
Next i
Next j
Next x
a = s1.[V1:Y36].Value2
say = 0
ReDim c(1 To UBound(a), 1 To 7)
For i = 1 To UBound(a)
say = say + 1
For j = 1 To UBound(a, 2)
If a(i, j) <> "" Then
deg = a(i, j)
ayir = Split(d(deg), "|")
For x = 1 To UBound(ayir)
c(say + 1, x) = ayir(x)
Next x
End If
Next j
Next i
s1.[O1].Resize(say, 7) = c
MsgBox CDate(TimeValue(Now) - Z), vbInformation
End Sub