VBA 데이터 추출

Question

Excel의 데이터를 사용하여 데이터베이스를 채우려 고 시도하고 있습니다 (원래 PDF에서 가져옴). 데이터는 내가 다음을 통해 검색하고 정보 수요가 추출 것을에서 다음 데이터를 보유하는 가상 매트릭스를 만든 예컨대

Event Date: 
02/02/02 
Location: 
UK 
Event: 
Fire 
Event Date: 
03/03/03 
Location: 
US 
Cause: 
Hurricane 

, 하나 개의 컬럼에 엑셀에 존재합니다.

그러나 모든 데이터 항목이 같은 형식을 따르지 않기 때문에 문제가 발생합니다.

그래서 데이터베이스를 채울 때 다음과 같이됩니다.

Date...................Location.................Cause..................Event 
02/02/02.............UK.........................Hurricane..............Fire 
03/03/03.............US.........................Flood...................Fire 
04/04/04.............France..............................................Structural Damage 
05/05/05.............Germany............................................Fire 

그러나 정보는 위에서 아래로 채워지기 때문에 정확한 데이터 등에 해당하지 않습니다.

정보를 다음과 같이 표시해야합니다.

Date.............Location........Cause......................Event 
02/02/02........UK..........................................Fire 
03/03/03........US...............Hurricane..................Fire 
04/04/04........France..........Flood.......................Structural Damage 
05/05/05........Germany......................................Fire 

아래 코드를 사용하여 데이터 추출을 시도했지만 필수 순서대로 정보를 추출하지 않고 추출했습니다. 데이터를 추출하는 동안 배열에 데이터를 할당하는 더 좋은 방법이 있습니까?

내 현재 코드 :

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean) 

Dim pd(100000, 100) 
Dim rpd(10000, 100) 
Dim c As Integer 
Dim npd As Variant 

rpd(1, 1) = "Loss Number" 
rpd(1, 2) = "Event Date" 
rpd(1, 3) = "Country" 
rpd(1, 4) = "Location" 
rpd(1, 5) = "Event" 
rpd(1, 6) = "Cause" 
rpd(1, 7) = "Unit Type" 
rpd(1, 8) = "Equipment Type" 
rpd(1, 9) = "Materials" 
rpd(1, 10) = "Fatalities" 
rpd(1, 11) = "Injuries" 
rpd(1, 12) = "Duration" 
rpd(1, 13) = "Evacuated" 
rpd(1, 14) = "Plant Status" 
rpd(1, 15) = "Interruption" 
rpd(1, 16) = "Description" 


c = 1 
cr = 1 
npd = 1 

LastRow = ThisWorkbook.Sheets("PDF Input Sheet").UsedRange.Rows.count 
Lastcol = ThisWorkbook.Sheets("PDF Input Sheet").UsedRange.Columns.count 

'Collect data for virtual matrix 
Do Until npd = LastRow 
    For c = 1 To Lastcol 
     pd(npd, c) = Sheets("PDF Input Sheet").Cells(npd, c) 
    Next c 
    npd = npd + 1 
Loop 

'Extract loss number data 
R = 1 
cr = 1 

Do Until R = npd 
If pd(R, 1) = "Loss Number:" Then 
    If pd(R + 1, 1) <> "" Then LossNumber = pd(R + 1, 1) 

    cr = cr + 1 

    rpd(cr, 1) = LossNumber 

End If 

R = R + 1 

Loop 

'Extract event date information 
R = 1 
cr = 1 

Do Until R = npd 
If pd(R, 1) = "Event Date:" Then 
    If pd(R + 1, 1) <> "" Then EveDate = pd(R + 1, 1) 

    cr = cr + 1 

    rpd(cr, 2) = EveDate 

End If 

R = R + 1 

Loop 

'Extract country data 
R = 1 
cr = 1 

Do Until R = npd 
If pd(R, 1) = "Country:" Then 
    If pd(R + 1, 1) <> "" Then Country = pd(R + 1, 1) 

    cr = cr + 1 

    rpd(cr, 3) = Country 

End If 

R = R + 1 

Loop 

'Extract location data 
R = 1 
cr = 1 

Do Until R = npd 
If pd(R, 1) = "Location:" Then 
    If pd(R + 1, 1) <> "" Then Location = pd(R + 1, 1) 

    cr = cr + 1 

    rpd(cr, 4) = Location 

End If 

R = R + 1 

Loop 

'Extract event data 
R = 1 
cr = 1 

Do Until R = npd 

If pd(R, 1) = "Event:" Then 
    If pd(R + 1, 1) <> "" Then Even = pd(R + 1, 1) 

    cr = cr + 1 

    rpd(cr, 5) = Even 


End If 

R = R + 1 

Loop 





Sheets("Accident Database").Activate 
Sheets("Accident Database").Columns("A:IV").ClearContents 
For R = 1 To 200 
    For c = 1 To 16 
    Sheets("Accident Database").Cells(R, c) = rpd(R, c) 
    Next c 
Next R 

'Range("A1:IV4000").Sort _ 
'Key1:=Range("B1"), Header:=xlYes 

Sheets("Accident Database").Columns("A:IV").AutoFit 




End Sub 

Answer 1

하지 대답,하지만 난 당신이 배열로 범위를 읽을 루프를 필요로하지 않는다는 것을 지적하고 싶습니다!

dim r() as variant 
r = range(cells(firstRow, firstCol) , cells((lastRow, lastCol)) 
'or 
r = range("B2:f20") 

트릭을 수행하고 훨씬 빠릅니다.