• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Dizi makrosunun ondalıkta virgülü noktaya dönüştürmesi

C

Carpintero

Katılım
2 Şubat 2014
Mesajlar
760
Excel Vers. ve Dili
2007 Türkçe
Merhaba arkadaşlar.
Buradan bir kez daha teşekkür ediyorum kendisine. Aşağıda ki kod
Sayın Korhan Hocanın dır. Ellerine sağlık.

Benim sorunum ise şu:
Sayfa1 den ondalık sayıları (virgüllü) dataya gönderiyorum.
Bu sayıları tekrar istediğimde ise virgül yerine nokta lı şekilde geliyor.
Ve bu sayıları tekrar göndermek istedğimde ise noktalar da siliniyor
ve sayı tam sayıya dönüşüyor. 20,345 sayısı 20345 oluyor.
Bu her sayıda olmuyor elbette. Sorun da burada zaten. Arada bazılarında oluyor.
Bu sebeple de teşhisini koyamadım maalesef.

Sayın Korhan Hocamın ve siz konuya hakim kişilerin değerli fikirlerini bekliyorum.
Ne yapabilir acaba ?


Sub Makro4()
Dim s1 As Worksheet, s2 As Worksheet, son As Long
Dim Zaman As Double, Dizi As Variant, s As Long, k As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Data")
'*************************************************************
tr = s2.Cells(s2.Rows.Count, "D").End(3).Row

Dizi = s2.Range("D1:T" & tr).Value
With CreateObject("Scripting.Dictionary")

For s = 3 To UBound(Dizi, 1)
.Item(Dizi(s, 3) & Dizi(s, 4) & Dizi(s, 5)) = Dizi(s, 7) & "#" & Dizi(s, 8) & "#" & Dizi(s, 9) & "#" & Dizi(s, 11) _
& "#" & Dizi(s, 12) & "#" & Dizi(s, 13) & "#" & Dizi(s, 14) & "#" & Dizi(s, 15) & "#" & Dizi(s, 16)

Next
'**************************************************************************************************
ws = s1.Cells(s1.Rows.Count, "H").End(3).Row
Dizi = s1.Range("F1:W" & ws).Value

For k = 2 To UBound(Dizi, 1)
If .exists(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)) Then

Dizi(k, 8) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(0)
Dizi(k, 9) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(1)
Dizi(k, 11) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(2)
Dizi(k, 12) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(3)
Dizi(k, 13) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(4)
Dizi(k, 14) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(5)
Dizi(k, 15) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(6)
Dizi(k, 16) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(7)

End If: Next
End With
s1.Range("F1:W" & UBound(Dizi)) = Dizi
Set s1 = Nothing: Set s2 = Nothing
Application.ScreenUpdating = True
End Sub
 
Sorun yaşadığınız datanızın küçük bir örneğini dosya olarak paylaşırsanız inceleme fırsatımız olur.
 
Merhaba Korhan Hocam.
Ondalık sayı sorununu metne çevirerek çözdüm.
Lakin bu dizi makrosunda şöyle bir sorun yaşıyorum.

Tek dosyayı 2 dosya halinde getirdim. Şimdi ise kod çalışmıyor.
Diğer döngülü kodlarda dosya ve sayfa tanımlamalarını
yapıyorum ama bu kodda ne yaptım ise olmadı.
Bu kodu 2 dosya arasında işlem yapıyor gibi nasıl düzenleyebilirim acaba ?

Dosya 1 "Günlük"
sayfa "Sayfa1"

Dosya 2 "Satış Raporları"
sayfa "Data"

bilgilirei ile kodu nasıl revize edebilirim acaba
Tüm adresler aynı.

Sub Makro4()
Dim s1 As Worksheet, s2 As Worksheet, son As Long
Dim Zaman As Double, Dizi As Variant, s As Long, k As Long

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Set s1 = Sheets("Sayfa1")
Set s2 = Sheets("Data")
'*************************************************************
tr = s2.Cells(s2.Rows.Count, "D").End(3).Row

Dizi = s2.Range("D1:T" & tr).Value
With CreateObject("Scripting.Dictionary")

For s = 3 To UBound(Dizi, 1)
.Item(Dizi(s, 3) & Dizi(s, 4) & Dizi(s, 5)) = Dizi(s, 7) & "#" & Dizi(s, 8) & "#" & Dizi(s, 9) & "#" & Dizi(s, 11) _
& "#" & Dizi(s, 12) & "#" & Dizi(s, 13) & "#" & Dizi(s, 14) & "#" & Dizi(s, 15) & "#" & Dizi(s, 16)

Next
'**************************************************************************************************
ws = s1.Cells(s1.Rows.Count, "H").End(3).Row
Dizi = s1.Range("F1:W" & ws).Value

For k = 2 To UBound(Dizi, 1)
If .exists(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)) Then

Dizi(k, 8) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(0)
Dizi(k, 9) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(1)
Dizi(k, 11) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(2)
Dizi(k, 12) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(3)
Dizi(k, 13) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(4)
Dizi(k, 14) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(5)
Dizi(k, 15) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(6)
Dizi(k, 16) = Split(.Item(Dizi(k, 1) & Dizi(k, 5) & Dizi(k, 6)), "#")(7)

End If: Next
End With
s1.Range("F1:W" & UBound(Dizi)) = Dizi
Set s1 = Nothing: Set s2 = Nothing
Application.ScreenUpdating = True
End Sub
 
Kodda sadece sayfa tanımlamaları var. Kod hangi sayfanın hangi dosyada olduğunu bilemez.

Bu sebeple dosya adlarınızı da tanımlamalara eklemelisiniz.
 
Sayın Hocam
hem Dosya hem Sayfa tanımlamasını yapamıyorum.
for döngülü kodlarda dosyayı tanımladıktan sonra
değişkenden sonra Sheets("xxx") gibi yazdıktan sonra Range
yada Cells yazıp devam ediyoruz ama bu kodda bunu yapamıyorum.
 
Bu durumda örnek dosyalarınızı paylaşın. Gerekli düzenlemeyi yapalım.
 
İki ayrı dosya olduğu için dosyaların açık olması gerekiyor. Ya da kodlamaya yol tanımlayıp dosyayı açmak gerekiyor.

Hangi şekilde olmasını istiyorsunuz?
 
Dosyalar açık olacak Hocam
mesajı düzenlemiştim ama hata almıştım
demek ki gitmemiş
 
Deneyiniz.

C++: 
Option Explicit

Sub Dosyalar_Arasi_Hizli_Duseyara()
    Dim K1 As Workbook, K2 As Workbook
    Dim S1 As Worksheet, S2 As Worksheet, Son As Long
    Dim Zaman As Double, Dizi As Variant, X As Long
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    Set K2 = Workbooks("Satış Raporları.xlsm")
    Set S2 = K2.Sheets("Data")
    
    Son = S2.Cells(S2.Rows.Count, "F").End(3).Row
    
    Dizi = S2.Range("F3:G" & Son).Value
    
    With CreateObject("Scripting.Dictionary")
        For X = LBound(Dizi, 1) To UBound(Dizi, 1)
            .Item(Dizi(X, 1)) = Dizi(X, 2)
        Next
        
        Son = S1.Cells(S1.Rows.Count, "C").End(3).Row
        Dizi = S1.Range("C4:D" & Son).Value
        
        For X = LBound(Dizi, 1) To UBound(Dizi, 1)
            If .Exists(Dizi(X, 1)) Then
                Dizi(X, 2) = .Item(Dizi(X, 1))
            End If
        Next
    End With
    
    S1.Range("C4").Resize(UBound(Dizi), 2) = Dizi
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set K1 = Nothing
    Set K2 = Nothing
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub
 
Çok teşekkür ederim Sayın Hocam.
Elinize sağlık.
İyi ki varsınız.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst