Google sheetten veri almak

mrwarrior · 9 Mayıs 2020

Kod:

Sub Verial()
'by Haluk
'Zaman = Timer
Set google = Sheets("Google")
Set googlebilgi = Sheets("Google Form Bilgi Alışı")
googlebilgi.Range("A9:G1000").ClearContents

For ders = 2 To 7
If googlebilgi.Cells(2, ders) <> "" Then
google.Select
    Dim myURL As String, mySh As Worksheet
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    google.Range("A1:ZZ1000") = ""
    
    myURL = googlebilgi.Cells(2, ders) 'Link

    
    
    With google.QueryTables.Add(Connection:="URL;" & myURL, Destination:=Range("$A$1"))
        .Name = "myTable"
'        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .BackgroundQuery = True
        .RefreshStyle = xlOverwriteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        
        .RefreshPeriod = 0
        
        .WebSelectionType = xlSpecifiedTables
        .WebTables = 1
        
        .WebFormatting = xlWebFormattingNone
        .WebPreFormattedTextToColumns = True
        .WebConsecutiveDelimitersAsOne = True
        .WebSingleBlockTextImport = False
        .WebDisableDateRecognition = False
        .WebDisableRedirections = False
        .Refresh BackgroundQuery:=False
    End With
    'MsgBox "İşleminiz tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation

    google.Rows(1).Delete
    google.Columns(1).Delete
    Application.DisplayAlerts = True
    son = google.Cells(google.Rows.Count, 1).End(3).Row
For i = son To 2 Step -1
If google.Cells(i, 1) = "" Then google.Rows(i).Delete
Next
    son = google.Cells(google.Rows.Count, 1).End(3).Row
For sil = son To 2 Step -1
If google.Cells(sil, 2) = google.Cells(sil - 1, 2) Then
google.Rows(sil - 1).Delete
End If
Next
For cevap = 1 To son
k = google.Cells(cevap, CDbl(googlebilgi.Cells(7, ders)))
    If k = CDbl(googlebilgi.Cells(3, ders)) Then
    cevapanahtarı = cevap
    GoTo cevapbulundu
End If
Next

cevapbulundu:
sonsut = google.Cells(1, google.Columns.Count).End(1).Column

For i = 1 To son

google.Cells(i, sonsut + 1) = google.Cells(i, 1) & ",,"
If googlebilgi.Cells(6, ders) <> "" Then
google.Cells(i, sonsut + 1) = google.Cells(i, sonsut + 1) & google.Cells(i, googlebilgi.Cells(6, ders)) & ","
Else
google.Cells(i, sonsut + 1) = google.Cells(i, sonsut + 1) & ","
End If
If googlebilgi.Cells(5, ders) <> "" Then
google.Cells(i, sonsut + 1) = google.Cells(i, sonsut + 1) & google.Cells(i, googlebilgi.Cells(5, ders)) & "," & google.Cells(i, googlebilgi.Cells(7, ders)) & ",,,,,,,,"
Else
google.Cells(i, sonsut + 1) = google.Cells(i, sonsut + 1) & "," & google.Cells(i, googlebilgi.Cells(7, ders)) & ",,,,,,,,"
End If



If googlebilgi.Cells(4, ders) <> "" Then
bas = CDbl(googlebilgi.Cells(4, ders))
Else
bas = 3
End If

For cevap = bas To sonsut
google.Cells(i, sonsut + 1) = google.Cells(i, sonsut + 1) & google.Cells(i, cevap) & "," & google.Cells(cevapanahtarı, cevap) & ",,,"
Next


Next
    Rows(cevapanahtarı).Delete
        For aktar = 1 To google.Cells(google.Rows.Count, 1).End(3).Row
            googlebilgi.Cells(aktar + 8, ders) = google.Cells(aktar, sonsut + 1)
        Next


End If
Next

Sheets("Google Form Bilgi Alışı").Select


End Sub

Bu kodla google sheetten veri alıyorum ve bazı düzenlemeler yapıyorum. Ama sorun 250 den fazla veri olmasına karşın sadece ilk 100 ünü alıyor. Acaba hepsini alması için ne yapmam gerekir?

kulomer46 · 9 Mayıs 2020

Merhaba

son = google.Cells(google.Rows.Count, 1).End(3).Row
kod satırını
son = google.Cells(google.Rows.Count, 1).End(3).Row+5000

olarak değiştirseniz acaba işe yarar mı?

Bir deneyiniz.

Selamlar...

Haluk · 9 Mayıs 2020

100'den fazla satıra sahip Google Sheet'den tüm verileri almak için kullandığınız URL'i modifiye etmek gerekir.

Örneğin, aşağıdaki linke 363 satırlık bir dosya ekledim.

'https://docs.google.com/spreadsheets/d/1fHpPX-jrT1lr9HEC7cKeNI1ASt4KB0iPJPPJy5mqKow/edit?usp=sharing

TestSheet

Sheet1 Test-1 Test-2 Test-3 Test-4 Test-5 Test-6 Test-7 Test-8 Test-9 Test-10 Test-11 Test-12 Test-13 Test-14 Test-15 Test-16 Test-17 Test-18 Test-19 Test-20 Test-21 Test-22 Test-23 Test-24 Test-25 Test-26 Test-27 Test-28 Test-29 Test-30 Test-31 Test-32 Test-33 Test-34 Test-35 Test-36 Test-37 Te...

docs.google.com

Daha önceden hazırladığım kodla, bu linkten sadece ilk 100 satırın verilerini alabilirsiniz.

Ama, URL'i aşağıdaki yapıya değiştitirseniz, tüm 363 satırdaki verileri alabilirsiniz. (URL'in başındaki tek tırnak işareti olmayacak)

'https://spreadsheets.google.com/spreadsheets/tq?tqx=out:html&tq=&key=1fHpPX-jrT1lr9HEC7cKeNI1ASt4KB0iPJPPJy5mqKow&gid=1

.

Haluk · 9 Mayıs 2020

URL'i modifiye etmek için ekli dosyayı kullanabilirsiniz ....

"Sarı renkli" alana orjinal URL'i girince, hemen altında modifiye URL düzenlenecektir...

Not: Ek dosya için 13 No'lu mesaja bakınız...

.

Muhammet Okumuş · 9 Mayıs 2020

Bende hata veriyor.

Haluk · 9 Mayıs 2020

Maalesef müneccim değilim, ne hatası veriyor...?

.

Muhammet Okumuş · 9 Mayıs 2020

Sayfa bulunamadı diyor.

Haluk · 9 Mayıs 2020

Orjinal URL'i verirseniz, duruma bakalım ...

.

Muhammet Okumuş · 9 Mayıs 2020

SOS-8

docs.google.com

Haluk · 9 Mayıs 2020

'https://spreadsheets.google.com/spreadsheets/tq?tqx=out:html&tq=&key=1YGgvfrrz9QW1oPmtUPm4xHZTzLWU7uuK4jfjnkSbmAk&gid=1

.

Muhammet Okumuş · 9 Mayıs 2020

Bu link çalıştı. Buna göre düzenlemem gerek o zaman. Ayrıca bu daha hızlı veri alıyor.

Muhammet Okumuş · 9 Mayıs 2020

=EĞER(AN4="";"";"https://spreadsheets.google.com/tq?tqx=out:html&tq=&key="&PARÇAAL(AN4;40;MBUL("/";AN4;40)-40)&"&gid=1")

Linki AN4 hücresine yapıştırıyorum.

Haluk · 9 Mayıs 2020

Dosya ...

.

Muhammet Okumuş · 9 Mayıs 2020

Haluk Bey, bu URL değişikliği verinin daha hızlı alınmasını sağlıyor. Dosyamdaki tüm adresleri bu yöntem ile değiştirdim. Çok daha iyi oldu.

Haluk · 9 Mayıs 2020

Güzel haber .... kolay gelsin.

.

tamer42 · 10 Kasım 2023

Haluk' Alıntı:
URL'i modifiye etmek için ekli dosyayı kullanabilirsiniz ....

"Sarı renkli" alana orjinal URL'i girince, hemen altında modifiye URL düzenlenecektir...

Not: Ek dosya için 13 No'lu mesaja bakınız...

.

Haluk Hocam aşağıdaki linkte verilen
Google sheet sayfasındaki verileri MS Excel ortamına çekmek için sizin burada vermiş olduğunuz uygulamayı kullandım; fakat boş geliyor, diğer bir deyişle herhangi bir veri getirmedi

https://docs.google.com/spreadsheets/d/1H81hDrhwlLkd7GCxgZDwSUPZvsDjyF1skK5hYFHiUqg/edit#gid=0

burada nerede nasıl bir hata yapıyor olabiliriz?
Desteğiniz için şimdiden teşekkürler,

excelokyanus500 · 10 Kasım 2023

Alternatif .Alıntıdır.

Kod:

Sub Import_Sheets_to_Excel()
'İndirilecek google sheet önceden tam paylaşılmış olmalıdır.

Dim QRT As QueryTable, ul As String, ky As String
If ActiveSheet.QueryTables.Count > 0 Then ActiveSheet.QueryTables(1).Delete
ActiveSheet.Cells.Clear
ky = "1SQVA9h2hwPlj-dsdsddfEwLbxSslM7GeMM" ' Sheet id
ul = "https://spreadsheets.google.com/tq?tqx=out:html&key=" & ky
Set QRT = ActiveSheet.QueryTables.Add(Connection:="URL;" & ul, _
Destination:=Range("$A$1"))
With QRT
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.Refresh
End With
End Sub

tamer42 · 10 Kasım 2023

excelokyanus500' Alıntı:

Alternatif .Alıntıdır.

Kod:

Sub Import_Sheets_to_Excel()
'İndirilecek google sheet önceden tam paylaşılmış olmalıdır.

Dim QRT As QueryTable, ul As String, ky As String
If ActiveSheet.QueryTables.Count > 0 Then ActiveSheet.QueryTables(1).Delete
ActiveSheet.Cells.Clear
ky = "1SQVA9h2hwPlj-dsdsddfEwLbxSslM7GeMM" ' Sheet id
ul = "https://spreadsheets.google.com/tq?tqx=out:html&key=" & ky
Set QRT = ActiveSheet.QueryTables.Add(Connection:="URL;" & ul, _
Destination:=Range("$A$1"))
With QRT
.WebSelectionType = xlAllTables
.WebFormatting = xlWebFormattingNone
.Refresh
End With
End Sub

Hocam teşekkür ederim,
Kodu çalıştırmak istediğimde, ekli ekran görüntüsündeki durum ortaya çıkıyor.
Tamam' a tıklayınca görünürde herhangi bir işlem yapmıyor.

https://docs.google.com/spreadsheets/d/1H81hDrhwlLkd7GCxgZDwSUPZvsDjyF1skK5hYFHiUqg/edit?usp=sharing

google sheet' in linkini sizinle paylaşıyorum bir kontrol edin isterseniz,
iyi çalışmalar.

tamer42 · 10 Kasım 2023

tamer42' Alıntı:
Hocam teşekkür ederim,
Kodu çalıştırmak istediğimde, ekli ekran görüntüsündeki durum ortaya çıkıyor.
Tamam' a tıklayınca görünürde herhangi bir işlem yapmıyor.

https://docs.google.com/spreadsheets/d/1H81hDrhwlLkd7GCxgZDwSUPZvsDjyF1skK5hYFHiUqg/edit?usp=sharing

google sheet' in linkini sizinle paylaşıyorum bir kontrol edin isterseniz,
iyi çalışmalar.

Paylaşım da "Genel ERİŞİM" kısmını kısmını düzenleyince sorun çözüldü, burada sanırım ilk tablodan verileri alıyor.

her şey için teşekkürler...

excelokyanus500 · 10 Kasım 2023

İstenilen sayfa için sheet'in urlseinde bulunan gid no alınmalı.

http://sheets/d/1fsfffffffffffffffffffffffffffDat5Rg/edit#gid=236907200

Aşağıdaki makro ile

Kod:

Sub GoogleTable()
      Dim key As String, url As String
      Dim HTTPreq As Object, HTML As Object
      Dim r As Integer, c As Integer
      Set HTTPreq = CreateObject("MSXML2.ServerXMLHTTP")
     
      key = "16yoXS6l3IYfdsdfdfHEMKOyDaW5Rg" ' 'Sayfa id no
      gid = "123456789" ' Url gid no
      'url = "https://spreadsheets.google.com/tq?tqx=out:html&key=" & key  ' İlk sayfa
      url = "https://spreadsheets.google.com/tq?tqx=out:html&key=" & key & "&gid=" & gid  ' İstenilen sayfa gid no

      With HTTPreq
          .Open "GET", url, False
          .send
      End With
      Do Until HTTPreq.readyState = 4: Loop

   
      Set HTML = CreateObject("htmlFile")
      HTML.body.innerHTML = HTTPreq.responseText

     
      For Each tr In HTML.getElementsByTagName("tr")
          If tr.getElementsByTagName("td").Length > 0 Then
              r = r + 1
              'If r <= 10 Then
                  For Each td In tr.getElementsByTagName("td")
                      c = c + 1
                      Cells(r, c).Value = td.innerText
                  Next td
                  c = 0
             
          End If
      Next tr
  End Sub

Ayrıca;

Sayfanızdaki permission işlemini google script ile otomatik yapabilirsiniz.Bunu sayfada bir kısa yola atayabilirsiniz.

Kod:

function paylasimyap() {
var ss = SpreadsheetApp.getActiveSpreadsheet();

var fileidesi =  ss.getId()
var drivedoc = DriveApp.getFileById(fileidesi);
drivedoc.setSharing(DriveApp.Access.ANYONE_WITH_LINK, DriveApp.Permission.EDIT);
}

function paylasimkaldir() {

var ss = SpreadsheetApp.getActiveSpreadsheet();

var fileidesi =  ss.getId()
var drivedoc = DriveApp.getFileById(fileidesi);
drivedoc.setSharing(DriveApp.Access.ANYONE, DriveApp.Permission.NONE);

}

Google sheetten veri almak

Özel Üye

Özel Üye

Destek Ekibi

Özel Üye

Destek Ekibi

Ekli dosyalar

Özel Üye

Destek Ekibi

Özel Üye

Destek Ekibi

Destek Ekibi

Özel Üye

Ekli dosyalar

Destek Ekibi

Özel Üye

Destek Ekibi

Ekli dosyalar

Destek Ekibi

Ekli dosyalar

Destek Ekibi

Ekli dosyalar