- Katılım
- 28 Eylül 2007
- Mesajlar
- 4,042
- Excel Vers. ve Dili
- 2013 Türkçe
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
excel.web.tr ekibinin katkılarıyla hazırlamış olduğum test okuma dosyasını sizlerle paylaşıyorum.
Google Sheet yapısı 1 No'lu mesaj ekindeki dosyada kullanılan Google Sheet yapısından farklı.... Aynı tablo yapısını kullanıp, tekrar deneyin bence.
.
Sub Google_Form()
'by Haluk
'Zaman = Timer
Sheets("Google").Select
Dim myURL As String, mySh As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Range("A1:ZZ1000") = ""
myURL = Sheets("Link-Cevap").Range("AJ4").Text
With ActiveSheet.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
Rows(1).Delete
Columns(1).Delete
Columns(2).Delete
Columns(2).Delete
son = Cells(Rows.Count, 1).End(3).Row
For i = son To 2 Step -1
If Cells(i, 1) = "" Then Rows(i).Delete
Next
Sheets("Test").Range("C8:AV107") = ""
Sheets("Test").Range("C8:AV107").Interior.ColorIndex = xlNone
son = Cells(Rows.Count, 1).End(3).Row
Sheets("Test").Range("D8107") = Range("B2:B101").Value
Sheets("Test").Range("S8:AV107") = Range("C2:AF101").Value
Sheets("Test").Select
Range("BD6").Select
Range("BG15") = WorksheetFunction.CountA(Sheets("Test").Range("S6:AV6"))
Range("C8:AV100").Borders.LineStyle = 0
son = Cells(Rows.Count, 4).End(3).Row
If son < 8 Then Exit Sub
Range("E8:E" & son) = "=IFERROR(VLOOKUP(D8,Liste!B:C,2,0),""???"")"
Range("E8:E" & son) = Range("E8:E" & son).Value
End Sub
Kodu bunla değişin veya
Columns(1).Delete
satırının altına
Columns(2).Delete
Columns(2).Delete
ekleme yapınız ve listenize öğrenci adlarını ekleyiniz.