stahac
Yeni Üye
- Katılım
- 10 Şub 2023
- Mesajlar
- 4
- En iyi yanıt
- 0
- Puanları
- 1
- Yaş
- 30
- Konum
- Izmir
- Ad Soyad
- Taha Coskun
- Office Vers.
- Office 2022 EN
Merhaba,
microsoft cihazlarda sorunsuz calisan formul macbooklarda With CreateObject("Scripting.Dictionary") hatasi veriyor. Formulu macbooklar icin uygun hale getirmek icin desteginizi rica ederim.
Sub Bulk_Data_Export()
Dim diller, veriler, s1 As Worksheet, dilKod$, i&, dil$
Set s1 = Sheets("Bulk_Data_Sheet")
With s1
diller = .Range("A2:B" & .Cells(Rows.Count, 1).End(3).Row).Value
veriler = .Range("D2:F" & .Cells(Rows.Count, 4).End(3).Row).Value
End With
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(diller)
.Item(diller(i, 1)) = diller(i, 2)
Next i
For Each s1 In Worksheets
.Item("_" & s1.Name) = s1.Name
Next
For i = 1 To UBound(veriler)
dilKod = Left(veriler(i, 3), 2)
If WorksheetFunction.IsNumber(dilKod) Then
dil = "Manual"
Else
If .exists(dilKod) Then
dil = .Item(dilKod)
Else
MsgBox dilKod & vbCr & "Dil listesinde bulunamadi ... " & vbCr & "«ikis yapilacak", vbCritical
Exit Sub
End If
End If
If .exists("_" & dil) Then
Set s1 = Sheets(dil)
Else
Set s1 = Sheets.Add(after:=Sheets(Worksheets.Count))
s1.Name = dil
.Item("_" & s1.Name) = s1.Name
s1.Range("A1").Resize(, 5).Value = Array("Company name", "E-Mail", "VAT-number", "Country Code", "Language")
s1.Columns.AutoFit
End If
s1.Cells(Rows.Count, 1).End(3).Offset(1).Resize(, 5).Value = Array(veriler(i, 1), veriler(i, 2), veriler(i, 3), dilKod, dil)
Next i
End With
End Sub
microsoft cihazlarda sorunsuz calisan formul macbooklarda With CreateObject("Scripting.Dictionary") hatasi veriyor. Formulu macbooklar icin uygun hale getirmek icin desteginizi rica ederim.
Sub Bulk_Data_Export()
Dim diller, veriler, s1 As Worksheet, dilKod$, i&, dil$
Set s1 = Sheets("Bulk_Data_Sheet")
With s1
diller = .Range("A2:B" & .Cells(Rows.Count, 1).End(3).Row).Value
veriler = .Range("D2:F" & .Cells(Rows.Count, 4).End(3).Row).Value
End With
With CreateObject("Scripting.Dictionary")
For i = 1 To UBound(diller)
.Item(diller(i, 1)) = diller(i, 2)
Next i
For Each s1 In Worksheets
.Item("_" & s1.Name) = s1.Name
Next
For i = 1 To UBound(veriler)
dilKod = Left(veriler(i, 3), 2)
If WorksheetFunction.IsNumber(dilKod) Then
dil = "Manual"
Else
If .exists(dilKod) Then
dil = .Item(dilKod)
Else
MsgBox dilKod & vbCr & "Dil listesinde bulunamadi ... " & vbCr & "«ikis yapilacak", vbCritical
Exit Sub
End If
End If
If .exists("_" & dil) Then
Set s1 = Sheets(dil)
Else
Set s1 = Sheets.Add(after:=Sheets(Worksheets.Count))
s1.Name = dil
.Item("_" & s1.Name) = s1.Name
s1.Range("A1").Resize(, 5).Value = Array("Company name", "E-Mail", "VAT-number", "Country Code", "Language")
s1.Columns.AutoFit
End If
s1.Cells(Rows.Count, 1).End(3).Offset(1).Resize(, 5).Value = Array(veriler(i, 1), veriler(i, 2), veriler(i, 3), dilKod, dil)
Next i
End With
End Sub