저장 데이터는 워크 시트

Question

배경

에 나는 소스 데이터에 직접 액세스하지 않는 데이터를 긁어해야합니다. 이것은 회사 내에서 승인 된 활동입니다.

html의 일부를 게시 할 수 없습니다. 그러나 코드의 스크랩 부분을 확인 했으므로 필요하지 않습니다.

는

내가 쓴하는 VBA 매크로

• 는 인트라넷 웹 사이트에
• 로드 한 워크 시트
내에서 셀의 내용에 제출 웹 사이트를 Internet Explorer 창
• 를 탐색을 엽니 다
• 고객 레코드를 얻는 프로세스
• 특정 웹 사이트 개체 ID가 표시됩니다.
• 데이터는에 저장하지 않습니다 :
• 는
• 메모리를
• 종료

문제를 비 웁니다 같은 통합 문서의 제 2의 워크 시트에 특정 아이디의 값을 저장합니다 워크 시트나는 무엇을 시도했다

:

• 통합 문서에 저장, 활성화 및 선택 명령을 사용하여 기존 출력 워크 시트
• 를 사용하여 새로운 출력 워크 시트
• 만들기

• 워크 시트 참조 방법 :

  01 연구의 동등한 양의와 함께 23,516,
  • 코드 이름
  • 시트 이름
  • 지수

• 철저한 시행 착오

강령 :

Option Explicit 

Sub GetxyzData() 

Dim rowCount As Integer 
Dim colCount As Integer 
Dim objIE As InternetExplorer 
Dim ele As Object 
Dim startRange As Range 
Dim NoteFound As Boolean 
Dim ContactFound As Boolean 
Dim itm As Object 

'Create the IE Object 
Set objIE = CreateObject("InternetExplorer.Application") 

'Set the position and size attributes of the IE Object 
objIE.Top = 0 
objIE.Left = 0 
objIE.Width = 800 
objIE.Height = 600 

'Set the visibility of the IE Object 
objIE.Visible = True 

'Check to see if there was an error with the website 
On Error Resume Next 
objIE.navigate ("http://xyz/xyz_Individual/Applications/xyz/SearchMain.aspx/") 

'Wait until the website is ready to begin along with error checking 
Do While objIE.Busy 
    DoEvents 

    'Check to see if there was an error loading the website 
    If Err.Number <> 0 Then 
     objIE.Quit 
     Set objIE = Nothing 
     GoTo Program_Exit 
    End If 

    'Wait until the website is ready to begin 
    Application.StatusBar = "Connecting to Website..." 
    DoEvents 
Loop 

'Set the Row Number to 1 since there is a header row 
rowCount = 1 

'Set the data entry into Excel in the First Column and row 
startRange = "A1" 

'Continue to loop through the Excel data until a blank entry is found in the ID Number column 
Do While Sheet5.Range("K" & rowCount) <> "" 

    'Populate the Prospect ID Number in the search box with value in cell "K + Counter" 
    objIE.document.getElementById("ctl00$txtProspectid").innerText = _ 
     "0" & Sheet5.Range("K" & rowCount).Value 

    'Click the search button 
    objIE.document.getElementById("ctl00_btnsearch").Click 

    'Wait until the website is ready to begin along with error checking 
    Do While objIE.Busy 
     Application.StatusBar = "Downloading information, Please wait..." 
     DoEvents 
    Loop 

    'Check to see if this is the first customer and click the appropriate Prospect hyperlink 
    If rowCount = 1 Then 
     objIE.document.getElementById("ctl00_GrdExtract_ctl03_btnsel").Click 
    Else 
     objIE.document.getElementById("ctl00_GrdMember_ctl03_lnkProspectID").Click 
    End If 

    'Wait until the website is ready to begin 
    Do While objIE.Busy 
     Application.StatusBar = "Downloading information, Please wait..." 
     DoEvents 
    Loop 

'Set table type indicators to know when we are processing the 1st data field in each 
    NoteFound = False 
    ContactFound = False 

'Get the data fields for PII, Contacts and Notes based on the common portion of ID name 
    With Sheets("MWData") 
     For Each itm In objIE.document.all 
     'If it is not a PII, Contact or Note field, then skip it 
     If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Or _ 
      itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Or _ 
      itm.ID Like "*ctl00_CPH1_tabconttop_TabpnlPI_txt*" Then 

      'Write itm.Value to screen if it is not blank 
      If itm.Value <> "" Then 
       MsgBox itm.Value 
      End If 

      ' Check to see if it is the first Contact field for the customer, if so save the 
      ' column number the last contact field holds and then increment the rowCounter to store 
      ' the first field of the Note fields. 
      If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlContact_grdContact*" Then 
       'If this is the first Contact field then we want to save the the current colCount 
       If ContactFound = False Then 
        .Range(colCount & rowCount) = "ContactStart = " & colCount 
        colCount = rowCount + 1 
        ContactFound = True 
       End If 
      End If 
      ' Check to see if it is the first Note field for the customer, if so save the 
      ' column number the last note field holds 
      If itm.ID Like "*ctl00_CPH1_tabcontbottom_tabpnlNotes_GrdUserNotes*" Then 
       'If this is the first Note field then we want to save the the current colCount 
       If NoteFound = False Then 
        .Range(colCount & rowCount) = "NoteStart = " & colCount 
        colCount = rowCount + 1 
        NoteFound = True 
       End If 
      End If 

      ' Store the fields value in the next available column on the same row 
      Sheets("MWData").Range(colCount & rowCount) = itm.Value 
      'Increment the column counter to the next to prepare to write the next field 
      colCount = colCount + 1 

     End If 

     Next itm 
    End With 

'Increment the row counter and set the column counter back to 1 
rowCount = rowCount + 1 
colCount = 1 

'Loop back to get the next customer entry 
Loop 

Application.StatusBar = "Download Complete....." 

'Exit the program if there was an error retrieving the website 
Program_Exit: 

'Clean up system resources before ending the program 
objIE.Quit 
Set objIE = Nothing 

End Sub 

Answer 1

당신은 당신의 코드에서이 .Range(colCount & rowCount) 여러 번 사용

.Range(colCount & rowCount) = "ContactStart = " & colCount

.Range(colCount & rowCount) = "NoteStart = " & colCount

Sheets("MWData").Range(colCount & rowCount) = itm.Value 그러나 colCount

및 rowCount 그래서이 예를 들어, 작동하지 않습니다 정수 당신은 Range(12)을 가질 것이고, colCount = 1과 rowCount = 2입니다.

Worksheet의 컬렉션을 사용할 수 있지만 Range 개체는 사용할 수 없습니다 (예 : Range).

바로 "DoEvents"루프 후에는`오류에 Next` 다시 시작을 취소하는 0` 오류 고토에

Sheets("MWData").Cells(rowCount, colCount) = itm.Value