- Katılım
- 28 Eylül 2007
- Mesajlar
- 4,024
- Excel Vers. ve Dili
- 2013 Türkçe
excel.web.tr ekibinin katkılarıyla hazırlamış olduğum test okuma dosyasını sizlerle paylaşıyorum.
Ekli dosyalar
-
251.2 KB Görüntüleme: 84
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.
Şu ana kadarki tüm sınavları bu şablonla yaptım. 1. ve 2. soruların cevaplarını görmüyor sadece. Kodlar üzerinde oynama yapmaya çalıştım ama nerede yapılacağını bulamadım. Kodlar benim şablondaki 2. ve 3. sütunu atlarsa herşey yerli yerine oturacak gibi. yardımcı olursanız çok makbule geçecek.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.
.
Kodu bunla değişin veyaSub 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
Çok teşekkür ederim. Elinize sağlık!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.