Astuces Excel
  1. Astuces Excel
  3. VBA pour gratter datatables du site web – erreur sur datatables vides
Intereting Posts
Connectez les files Flat en utilisant java jdbc Trier le tableau ou la feuille de calcul Trouver des loggings en double lors de l'import de file Excel dans asp.net? Exportation HTML vers Excel dans IE11 – "Accès refusé" Comment cacher la colonne dans la list de list multicolines à l'aide de VBA lecture excel sur une database python à partir de la ligne 5 et incluant les en-têtes Existe-t-il un moyen de vérifier datatables pour son type de données dans VBA Applescript – Apple Event Timed out VBA: une meilleure solution requirejse pour le téléchargement de plusieurs files En essayant de faciliter mon travail en trouvant et en appariant des valeurs sur Excel vba count les en-têtes et copy la ligne active de même longueur sur la nouvelle feuille Fusion des cellules et avertissement d'exception générale Suppression d'un file à l'aide de VBA Variable de partage Excel VBA dans Userfrom Subs Trouver une string et renvoyer des informations à partir d'une cellule adjacente

VBA pour gratter datatables du site web – erreur sur datatables vides

Je crée une macro pour récupérer datatables à partir d'un site Web. Le problème que j'avais est lorsque la dernière page complète est grattée et la colonne A n'a pas de données, mais les autres colonnes, je reçois une erreur d'exécution 1004. Par exemple, si le total des pages à gratter est de 6, et la colonne A n'a pas de données sur la dernière input à la page 5, la macro récupérera toutes datatables à la page 5, mais lance l'erreur d'exécution en essayant d'get à la page 6. Il existe également des données à la page 6, mais je pense que, puisqu'il n'y a pas de données dans la colonne A, il décide simplement de donner l'erreur d'exécution. Des idées à ce sujet? En outre, avec le code que je comprend, serait-il plus facile d'avoir la boucle macro jusqu'à ce que la prochaine flèche disparue? Dans l'affirmative, comment procéder? 

'Macro to query Daily Activity Search for DFB Counties 'Run Monday to pull data from Friday Sub queryActivityDailyMforFWorking() Dim nextrow As Integer, i As Integer Dim dates dates = Date - 3 Application.ScreenUpdating = False Application.DisplayStatusBar = True Do While i <= 50 Application.StatusBar = "Processing Page " & i nextrow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).row + 1 With ActiveSheet.QueryTables.Add(Connection:= _ "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=R&send_date=" & dates & "&search_1.x=1", _ Destination:=Range("A" & nextrow)) '.Name = _ "2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name=" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "10" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False 'autofit columns Columns("A:G").Select Selection.EntireColumn.AutoFit 'check for filter, if not then turn on filter ActiveSheet.AutoFilterMode = False If Not ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A:G").AutoFilter End If i = i + 1 End With Application.StatusBar = False 'Align text left Cells.Select With Selection .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Loop End Sub

Je n'ai pas réussi à reproduire votre erreur, mais je devine que cela a trait à votre variable suivante. Si datatables sur une page se sont terminées par une cellule vide, la valeur de nextrow pour la page suivante de données serait définie dans datatables de la page précédente. Je pense que cela causerait certains problèmes lorsque vous ajoutez une autre table de requête, puis essayez de rafraîchir datatables car les tables se chevaucheront. Vous pouvez contourner cela en obtenant la rangée inférieure de l'une des autres colonnes si vous en connaissez une qui aura toujours des données pour chaque ligne. J'ai fait quelques mises à jour et ça me semble très bien pour moi:

  • Gestion des erreurs ajoutée
  • Vérifiez les colonnes A et B pour la rangée de données inférieure
  • Ajout d'une certaine logique pour vérifier si une page complète a été renvoyée et si elle ne quittait pas la boucle afin de ne pas continuer à parsingr des pages vides
  • Formaté la date dans la string de connection car j'ai constaté que cela causait des problèmes dans le passé
  • Ajout de la possibilité de se débarrasser des en-têtes si vous ne les voulez pas
  • Déplacer le formatting de la cellule hors de la boucle afin qu'il ne soit exécuté qu'une seule fois

J'espère que cela t'aides. 

 Sub queryActivityDailyMforFWorking() On Error GoTo Err_queryActivityDailyMforFWorking Const RowsPerPage As Byte = 20 Const DeleteHeader As Boolean = True Dim nextrow As Integer, maxrow As Integer, i As Integer Dim dates As Date dates = Date - 3 Application.ScreenUpdating = False Application.DisplayStatusBar = True nextrow = 1 For i = 1 To 50 Application.StatusBar = "Processing Page " & i With ActiveSheet.QueryTables.Add(Connection:= _ "URL;https://www.myfloridalicense.com/delinquency_results.asp?SID=&page=" & i & "&county_1=16&county_1=21&county_1=23&county_1=32&county_1=36&county_1=41&county_1=46&county_1=53&county_1=54&county_1=57&county_1=60&county_1=66&status=R&send_date=" & Format(dates, "m/d/yyyy") & "&search_1.x=1", _ Destination:=Range("A" & nextrow)) '.Name = _ "2015&search_1.x=40&search_1.y=11&date=on&county_1=AL&lic_num_del=&lic_num_rep=&status=NS&biz_name=&owner_name=" .FieldNames = False .RowNumbers = False .FillAdjacentFormulas = False .PreserveFormatting = True .RefreshOnFileOpen = False .BackgroundQuery = True .RefreshStyle = xlInsertDeleteCells .SavePassword = False .SaveData = True .AdjustColumnWidth = True .RefreshPeriod = 0 .WebSelectionType = xlSpecifiedTables .WebFormatting = xlWebFormattingNone .WebTables = "10" .WebPreFormattedTextToColumns = True .WebConsecutiveDelimitersAsOne = True .WebSingleBlockTextImport = False .WebDisableDateRecognition = False .WebDisableRedirections = False .Refresh BackgroundQuery:=False End With ' Delete the header as required If DeleteHeader And i > 1 And ActiveSheet.Cells(nextrow, 1).Value = "License" Then ActiveSheet.Cells(nextrow, 1).EntireRow.Delete ' Find the bottom row maxrow = Application.WorksheetFunction.Max(ActiveSheet.Cells(Rows.Count, 1).End(xlUp).Row, ActiveSheet.Cells(Rows.Count, 2).End(xlUp).Row) ' Stop scraping if a full page wasn't returned If (maxrow - nextrow) < (RowsPerPage - IIf(DeleteHeader, 1, 0)) Then Exit For ' Otherwise set the row for the next page of data Else nextrow = maxrow + 1 End If Next i Application.StatusBar = "Formatting data" 'autofit columns ActiveSheet.Columns.EntireColumn.AutoFit 'check for filter, if not then turn on filter ActiveSheet.AutoFilterMode = False If Not ActiveSheet.AutoFilterMode Then ActiveSheet.Range("A:G").AutoFilter 'Align text left With ActiveSheet.Cells .HorizontalAlignment = xlLeft .VerticalAlignment = xlBottom .WrapText = False .Orientation = 0 .AddIndent = False .IndentLevel = 0 .ShrinkToFit = False .ReadingOrder = xlContext .MergeCells = False End With Exit_queryActivityDailyMforFWorking: Application.StatusBar = False Application.ScreenUpdating = True Exit Sub Err_queryActivityDailyMforFWorking: MsgBox Err.Description, vbCritical + vbOKOnly, Err.Number & " - Web Scraping Error" Resume Exit_queryActivityDailyMforFWorking End Sub