Excel / 使用SeleniumBasic查詢發布到網路的google sheets V2

Excel / 使用SeleniumBasic查詢發布到網路的google sheets V2

Post Views: 4,975

同樣是抓取表單資料，可利用SeleniumBasic模擬操作瀏覽器抓取網頁資料

googel 試算表可以發布到網路，也就是將試算表轉變成網頁形式

如果直接抓取頁面資料貼回到Excel裡會有一些空白列

在 「Excel / 使用SeleniumBasic查詢發佈到網路的google sheets」的最後有提到需要再處理

趁這次辦理研習需要隨時彙整表單填寫情況

來整理之前的VBA程式

前置作業，必須將表單試算表到網路

但是表單填寫不是按照名單順序的

為了方便彙整，並且知道名單上還有誰沒有填寫表單

在表單工作簿新增了一個工作表，除了名單之外

透過VlookUp函數，查無對應的資料返回#N/A，就可以知道填寫情況

之後要發布到網路的也是這個工作表

操作介面

 

googel sheet 發布到網路的工作表

 

VBA程式

程式碼修改的部分都是處理格式居多，依照當前的工作表欄位做設定

透過函數統計#N/A的數量-還沒填寫、X-取消報名

在每個工作表的J欄新增顯示填寫狀況的資料

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
 
Sub WebTable42()
    Dim BOT As Object
    Set BOT = New WebDriver
    
    Application.ScreenUpdating = False
    
    Dim r As Integer
    r = Sheets(1).Range("A1").End(xlDown).Row
    
    '將前次查詢紀錄移到E、F欄
    Sheets(1).Range("C2:D" & r).Copy
    Sheets(1).Range("E2").PasteSpecial Paste:=xlPasteAll
    Application.CutCopyMode = False
    
    '清除前次查詢紀錄
    Sheets(1).Range("C2:D" & r).ClearContents
    
    Dim i As Integer
    Dim j As Integer
    Dim rr As Integer
    Dim q As Integer
    Dim TableName As String
    Dim TableUrl As String
    
    For i = 2 To r
        TableName = Sheets(1).Range("A" & i).Value
        TableUrl = Sheets(1).Range("B" & i).Value
        
        '如果有重複名稱工作表則刪除
        
        For j = 2 To Sheets.Count
        
            If Sheets(j).Name = TableName Then
                '關閉警告提示
                Application.DisplayAlerts = False
               
                Sheets(j).Delete
               
                Application.DisplayAlerts = True
                Exit For
        End If
    Next
            
        Sheets.Add after:=Sheets(Sheets.Count)
    
        Sheets(Sheets.Count).Name = TableName
          
        Application.CutCopyMode = False    ' clears the clipboard
        
        BOT.AddArgument "--headless"                        '只能用在Chrome
        BOT.Start "chrome"                                  'Chrome-> BOT.Start "chrome"
        BOT.Wait (1000)
        
        BOT.Get TableUrl
        BOT.Wait (1000)
'       BOT.FindElementByXPath("//*[@id='2014788522']/div/table").AsTable.ToExcel Sheets(2).Range("A1")
     
        BOT.FindElementByCss(".waffle").AsTable.ToExcel Sheets(TableName).Range("A1")
        
'       調整內容
'       刪除空白列
        With Sheets(TableName).Rows("1:1")
            .Delete Shift:=xlUp
        End With
        
        rr = Sheets(TableName).Range("A1").End(xlDown).Row
        
        '有資料才處理
        If rr <> 1045678 Then
        
'           修改A欄的內容
            With Sheets(TableName).Range("A1")
                .ClearContents
                .FormulaR1C1 = "序號"
            End With
            
            For q = 2 To rr
               With Sheets(TableName).Range("A" & q)
                    .FormulaR1C1 = "=ROW()-1"
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
               End With
               
               '調整E欄內容置中
               With Sheets(TableName).Range("E" & q)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
               End With
               
               '調整F欄內容置中
                With Sheets(TableName).Range("F" & q)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                
                '調整H欄內容置中
                With Sheets(TableName).Range("H" & q)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                
                '調整I欄內容置中
                With Sheets(TableName).Range("I" & q)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
                
                '調整J欄內容置中
                With Sheets(TableName).Range("J" & q)
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                End With
            Next
           
            '設定k欄資料
            Dim jAll As Integer
            jAll = Sheets(TableName).Range("J1").End(xlDown).Row - 1
            
            Dim rng1 As Range
            Dim j1 As Integer
            Dim jX As Integer
            
            Set rng1 = Range("J2:J" & jAll + 1)
           
            j1 = Application.WorksheetFunction.CountIf(rng1, "#N/A")
            jX = Application.WorksheetFunction.CountIf(rng1, "X")
            
            Sheets(TableName).Range("K1").Value = "填寫人數"
            
            Dim kk As String
            kk = "填寫：" & jAll - j1 - jX & "，取消：" & jX & "，總數：" & jAll
            
            Sheets(TableName).Range("K2").Value = kk
            
            Dim cc As Integer
            cc = Sheets(TableName).Range("A1").End(xlToRight).Column
            '標題欄內容置中
            With Sheets(TableName).Range(Cells(1, 1), Cells(1, cc))
               .HorizontalAlignment = xlCenter
               .VerticalAlignment = xlCenter
            End With
         
            '調整欄寬 列高
            With Sheets(TableName).Range(Cells(1, 1), Cells(rr, cc))
               .Columns.AutoFit
               .Rows.AutoFit
            End With
            
            '將填寫人數寫入第一個工作表
            Sheets("連線").Range("C" & i).Value = Sheets(TableName).Range("K2")
           
            '將查詢時間寫入第一個工作表
            Sheets("連線").Range("D" & i).Value = Format(Now(), "yyyy/mm/dd--Hh:Nn:Ss")
           
        End If
    Next

    BOT.Quit
    Set BOT = Nothing
    Sheets("連線").Activate
    Range("C2").Activate
    Application.ScreenUpdating = True
End Sub

 

個別工作表調整格式後的樣式

Tags: