Web 提取代码需要更新，尝试添加 sheet from worksheet Cell

Question

我正在尝试编写这行代码，因此需要 sheet 从 Sheet + 单元格中使用 excel 我可以使用 class和child点头，但不为sheet输入数据。对 A 到 K

列重复代码

我知道即使这不是最好的，但我在 VBA 方面受到限制并且它确实有效。我已经从 Sheet3 更改为 Sheet4，也发布在这里 Mr Excel

当前可用的代码

'Sheet20 A18 + B18
If element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")) Is Nothing Then ' Get CLASS and Child Nod
    wsSheet.Cells(Sheet4.Cells(Sheet4.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-" 'If Nothing then Hyphen in CELL
Else
    HtmlText = element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")).innerText ' Get CLASS and Child Nod
    wsSheet.Cells(Sheet4.Cells(Sheet4.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText 'return value in column
End If

目前的结果，仍然需要在 Class 和 Child Nods

中稍作调整

我正在尝试实施的新变化

Sheet4 取自 Sheet20 上的单元格 E16。这将根据选择的选项卡不断变化，因此数据需要进入正确的 sheet。我将多次使用此代码，而不是 re-write 每次 sheet。我想更改代码中的输入 sheet。这样我就可以更改 class + child 点头 + sheet 来添加数据，从而使我能够使用 ONE 代码。

If element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")) Is Nothing Then ' Get CLASS and Child Nod '''#### Instead of Sheet4 I am trying to get the required sheet from SHEET20 Cell E16 wsSheet.Cells(Sheets("Sheet20").Range("E16").Cells(Sheets("Sheet20").Range("E16").Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-" 'If Nothing then Hyphen Else HtmlText = element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")).innerText ' Get CLASS and Child Nod '''#### Instead of Sheet4 I am trying to get the required sheet from SHEET20 Cell E16 wsSheet.Cells(Sheets("Sheet20").Range("E16").Cells(Sheets("Sheet20").Range("E16").Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText 'return value in column

这是新代码的结果

问题

虽然选择了正确的sheet，但所有提取的数据都会进入相同的单元格覆盖和以前的数据，当它显示转到下一行时，如上图所示。

'##### 编辑今天英国时间 2.44 ######

这些是代码从 sheet20 开始使用的 HTML classes，我可以在单击按钮时继续更改 classes

这是 Sheet20 单元格 E16。这也会不断变化，我试图做的是让代码使用这个单元格
中声明的sheet

Answer 1

这个问题主要由 QHarr 回答。谢谢你的帮助。我遇到了一些小问题，例如需要对象和对象变量或未定义块变量。我能够像这样修复它

QHarr 的代码

Dim sht As Worksheet
 
Set sht = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets("Sheet20").Range("E16").Value)
 
If element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")) Is Nothing Then ' Get CLASS and Child Nod
    wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-" 'If Nothing then Hyphen in CELL
Else
    HtmlText = element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")).innerText ' Get CLASS and Child Nod
    wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText 'return value in column
End If

通过我的更改，不确定为什么我会遇到问题，但这解决了问题并且数据提取正常。

Dim wsSheet As Worksheet 
Dim wb As Workbook
Dim sht As Worksheet
    Set wb = ThisWorkbook
         Set wsSheet = wb.Sheets(wb.Sheets("Sheet20").Range("e16").Value)
         Set sht = ThisWorkbook.Worksheets(ThisWorkbook.Worksheets("Sheet20").Range("E16").Value)

If element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")) Is Nothing Then ' Get CLASS and Child Nod
    wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = "-" 'If Nothing then Hyphen in CELL
Else
    HtmlText = element.getElementsByClassName(Sheets("Sheet20").Range("A18"))(Sheets("Sheet20").Range("B18")).innerText ' Get CLASS and Child Nod
    wsSheet.Cells(sht.Cells(sht.Rows.Count, "A").End(xlUp).Row + 1, "A").Value = HtmlText 'return value in column
End If

Web 提取代码需要更新，尝试添加 sheet from worksheet Cell

Web Extraction code needs UPDATING, Trying to add sheet from worksheet Cell

excel

vba

web-scraping

screen-scraping