Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Welcome To Ask or Share your Answers For Others

Categories

0 votes
194 views
in Technique[技术] by (71.8m points)

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

I am trying to write this line of code so it takes the sheet to use from a Sheet + cell in excel I can do it with the class and child nods, but not for the sheet to input the data Into. The code is repeated for columns A to K

I know that even this is not the best, however I am limited in VBA and it does work. I have Changed from Sheet3 to Sheet4, Also Posted Here Mr Excel

Current Code that Works

'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

Current Results, still need a slight tweak in the Class and Child Nods

Product Image 1

The NEW Changes I am trying to implement

Sheet4 is taken from Cell E16 on Sheet20. This will KEEP CHANGING depending on which tab is selected and therefore the data needs to go into the correct sheet. I will be using this code several times and rather that re-write it each time for each sheet. I want to change the input sheet within the code. This way I can change the class + child nods + sheet to add data too, thus enabling me to use the ONE code.

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

This is the results with the new Code

Product Picture 2

Problem

Although the correct sheet is selected, ALL of the extracted data goes into the SAME cells overwriting and previous data, when it show go to next row, as show in the above image.

'##### Edit Today 2.44 uk time ######

These are the HTML classes that the code uses from sheet20, I can keep changing the classes on a button click

HTML Class

This is Sheet20 Cell E16. This will Also keep changing, what i was trying to do was get the code to use which ever sheet is stated in this cell

Active Sheet

question from:https://stackoverflow.com/questions/65642769/web-extraction-code-needs-updating-trying-to-add-sheet-from-worksheet-cell

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome To Ask or Share your Answers For Others

1 Answer

0 votes
by (71.8m points)

This Question was Answered largely By QHarr. Thanks for Your Help. I had a few minor issues, like object required and Object Variable or with block variable not defined. I was able to fix it like this

QHarr's Code

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

With my Changes, not sure why I was having the issues, but this fixed the problem and the data is extracted fine.

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

与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…
Welcome to OStack Knowledge Sharing Community for programmer and developer-Open, Learning and Share
Click Here to Ask a Question

...