Soru makroda " kopyası alma sorunu

bycakir

Altın Üye
Katılım
1 Aralık 2017
Mesajlar
222
Excel Vers. ve Dili
Microsoft Office 365 ProPlus
Altın Üyelik Bitiş Tarihi
18-01-2025
merhabalar aşağıdaki gibi bir makro hazırladım ama " kaydı almaya calıştıgımda hata alıyorum
yapmaya çalıştıgım excel a b ve c stunundan veri alıp aşagıdaki gibi kopya almak 0 1 2 diye kopya ekleyerek tek satırda birleşecek

{"0":{"token":"vipkeyshop112","rank":"1","days":"3"},"1":{"token":"vipkeyshop113","rank":"1","days":"5"}}

Kod:
Sub kayit()
  With CreateObject("Scripting.Dictionary")
      
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
            ver = "{"" & Range("A" &i) & ":{"token":"" & Range ("B" & i) & "","rank":"1","days":"" & Range("C" & i) & ""},"
            
                
            
        Next
        ver = "}}": GoSub ekle

        Set dataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        dataObject.SetText Join(.items, "")
        dataObject.PutInClipboard
        Set dataObject = Nothing
        
        MsgBox "Kayıt hazırlanmıştır...", vbInformation, "..::Ömür ÇAKIR::.."
    
       Exit Sub
ekle:
        .Item(.Count + 1) = ver & vbCrLf
        Return
End With
    
End Sub
 
Katılım
24 Nisan 2005
Mesajlar
3,671
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Bu şekilde deneyin.

C#:
Sub kayit()
  With CreateObject("Scripting.Dictionary")
        say = 0
        ver = ""
        For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
            If i = 1 Then
              ver = "{""" & Range("A" & i) & """:{""token"":""" & Range("B" & i) & """,""rank"":""1"",""days"":""" & Range("C" & i) & """},"""
            Else
            ver = ver & "" & Range("A" & i) & """:{""token"":""" & Range("B" & i) & """,""rank"":""1"",""days"":""" & Range("C" & i) & """},"""
            End If
            
        Next
        ver = Mid(ver, 1, Len(ver) - 2) & "}"
        GoSub ekle

        Set dataObject = CreateObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        dataObject.SetText Join(.items, "")
        dataObject.PutInClipboard
        Set dataObject = Nothing
        
        MsgBox "Kayıt hazırlanmıştır...", vbInformation, "..::Ömür ÇAKIR::.."
    
       Exit Sub
ekle:
        .Item(.Count + 1) = ver & vbCrLf
        Return
End With
 
Üst