- Katılım
- 26 Ocak 2013
- Mesajlar
- 232
- Excel Vers. ve Dili
- Excel 2016 Türkçe
- Altın Üyelik Bitiş Tarihi
- 26-11-2023
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