Herkesin işine yarayacak Bir kod (Excel Sihirbaz)

[sugarmania]

Aşağıda Verdiğim kod'da 2 excel sayfasında 1 sayfadan diğer sayfaya karakter eşleştirerek karakterin sağına doğru 1.sayfadaki verilere bakarak aynı verileri yazması kodudur.


Vereceğim örnek kitapta kantrol edebilirsiniz...
Saygılar...

Option Explicit
Dim Kapat As Boolean
Dim Dur As Boolean

Private Sub cmdDur_Click()
If MsgBox("İşlemi Durdurmak istediğinizden eminmisiniz?", vbExclamation + vbYesNo, "İşlemi Durdur") = vbYes Then
Dur = True
DoEvents
End If
End Sub

Private Sub ProgressBar1_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)

End Sub

Private Sub UserForm_Activate()
Dim VeriTabanıKayıtSayısı As Double
Dim TabloKayıtSayısı As Double
Dim VeriTabanıBak As Double
Dim TabloyaBak As Double
Dim Günler As Byte
Kapat = True
TabloKayıtSayısı = Sheets(Sayfa2.Name).UsedRange.Rows.Count
VeriTabanıKayıtSayısı = Sheets(Sayfa3.Name).UsedRange.Rows.Count
ProgressBar1.Max = (VeriTabanıKayıtSayısı * TabloKayıtSayısı) + TabloKayıtSayısı
ProgressBar2.Max = TabloKayıtSayısı + 1
For VeriTabanıBak = 2 To VeriTabanıKayıtSayısı + 1
For TabloyaBak = 2 To TabloKayıtSayısı + 1
ProgressBar1 = ProgressBar1 + 1
LabelTamamlanan.Caption = "Tamamlanan: %" & Int(ProgressBar1 / (ProgressBar1.Max / 100))
LabelBakılanPersonel.Caption = "Bakılan Personel: " & Sheets(Sayfa3.Name).Cells(VeriTabanıBak, 1).Value
DoEvents
If Sheets(Sayfa2.Name).Cells(TabloyaBak, 1).Value = Sheets(Sayfa3.Name).Cells(VeriTabanıBak, 1).Value Then
For Günler = 1 To 31
'If IsNumeric(Sheets(Sayfa2.Name).Cells(TabloyaBak, Günler + 3).Value) And Sheets(Sayfa2.Name).Cells(TabloyaBak, Günler + 3).Value <> "" Then

Sheets(Sayfa3.Name).Cells(VeriTabanıBak, Günler + 1).Value = Sheets(Sayfa2.Name).Cells(TabloyaBak, Günler + 1).Value

'End If
Next Günler
End If
ProgressBar2 = TabloyaBak
If Dur = True Then
Kapat = False
Unload Me
Exit Sub
End If
Next TabloyaBak
Next VeriTabanıBak
LabelTamamlanan.Caption = "Tamamlanan: %100"
MsgBox "İşlem tamamlandı...", vbInformation, "Sihirbaz"
Kapat = False
Unload Me
End Sub

Private Sub UserForm_Initialize()
ThisWorkbook.Activate
Sheets(Sayfa3.Name).Select
Dur = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = Kapat
End Sub

 

[tahsinanarat]

Ben sihirbazdaki bilgileri de&#287;i&#351;tirerek denedim, MESLEK ve DURUM bilgileri g&#252;ncellemiyor, bilgilerinize

 

[sugarmania]

Ben sihirbazdaki bilgileri de&#287;i&#351;tirerek denedim, MESLEK ve DURUM bilgileri g&#252;ncellemiyor, bilgilerinize

Kodlar de&#287;i&#351;ti &#351;imdi Ayn&#305; ko&#351;ullara g&#246;re arama yap&#305;yor '.s&#252;tundan itibaren bak&#305;yor Ve yeni yaz&#305;lan de&#287;erlere 2. Sutundan itibaren yazmaya ba&#351;l&#305;yor

Option Explicit
Dim kapat As Boolean
Dim Dur As Boolean

Private Sub cmdDur_Click()
If MsgBox("&#304;&#351;lemi Durdurmak istedi&#287;inizden eminmisiniz?", vbExclamation + vbYesNo, "&#304;&#351;lemi Durdur") = vbYes Then
Dur = True
DoEvents
End If
End Sub

Private Sub UserForm_Activate()
Dim VeriTaban&#305;Kay&#305;tSay&#305;s&#305; As Double
Dim TabloKay&#305;tSay&#305;s&#305; As Double
Dim VeriTaban&#305;Bak As Double
Dim TabloyaBak As Double
Dim G&#252;nler As Byte
kapat = True
TabloKay&#305;tSay&#305;s&#305; = Sheets(Sayfa2.Name).UsedRange.Rows.Count
VeriTaban&#305;Kay&#305;tSay&#305;s&#305; = Sheets(Sayfa3.Name).UsedRange.Rows.Count
ProgressBar1.Max = (VeriTaban&#305;Kay&#305;tSay&#305;s&#305; * TabloKay&#305;tSay&#305;s&#305 + TabloKay&#305;tSay&#305;s&#305;
ProgressBar2.Max = TabloKay&#305;tSay&#305;s&#305; + 1
For VeriTaban&#305;Bak = 2 To VeriTaban&#305;Kay&#305;tSay&#305;s&#305; + 1
For TabloyaBak = 2 To TabloKay&#305;tSay&#305;s&#305; + 1
ProgressBar1 = ProgressBar1 + 1
LabelTamamlanan.Caption = "Tamamlanan: &#37;" & Int(ProgressBar1 / (ProgressBar1.Max / 100))
LabelBak&#305;lanPersonel.Caption = "Bak&#305;lan Personel: " & Sheets(Sayfa3.Name).Cells(VeriTaban&#305;Bak, 1).Value
DoEvents
If Sheets(Sayfa2.Name).Cells(TabloyaBak, 1).Value = Sheets(Sayfa3.Name).Cells(VeriTaban&#305;Bak, 1).Value Then
For G&#252;nler = 1 To 60
If IsNumeric(Sheets(Sayfa2.Name).Cells(TabloyaBak, G&#252;nler + 1).Value) And Sheets(Sayfa2.Name).Cells(TabloyaBak, G&#252;nler + 1).Value <> "" Then

Sheets(Sayfa3.Name).Cells(VeriTaban&#305;Bak, G&#252;nler + 1).Value = Sheets(Sayfa2.Name).Cells(TabloyaBak, G&#252;nler + 1).Value

End If
Next G&#252;nler
End If
ProgressBar2 = TabloyaBak
If Dur = True Then
kapat = False
Unload Me
Exit Sub
End If
Next TabloyaBak
Next VeriTaban&#305;Bak
LabelTamamlanan.Caption = "Tamamlanan: %100"
MsgBox "&#304;&#351;lem tamamland&#305;...", vbInformation, "Ayl&#305;k Son Puantaj"
kapat = False
Unload Me
End Sub

Private Sub UserForm_Initialize()
ThisWorkbook.Activate
Sheets(Sayfa3.Name).Select
Dur = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Cancel = kapat
End Sub

 

[tahsinanarat]

Olmas&#305;n&#305; &#231;ok isterdim, ama denedim yine olmuyor, olmu&#351; haliyle dosyay&#305; eklerseniz sevinirim