행 삽입 VBA

Question

지금 나는 직원이 데이터 입력을 위해 사용하는 마스터 Excel 통합 문서를 가지고 있습니다. 각자는 자신의 데스크톱에 사본을 다운로드 한 다음 완료된 데이터 옆에있는 "x"를 입력하여 다양한 항목에 대한 진행 상황을 표시합니다. 각 제품에는 해당 행에 해당 데이터가 나열되어 있습니다. 마스터 통합 문서는 분기마다 데이터가있는 범위를 복사하는 매크로를 사용하여 각 개인 통합 문서에서 현재 업데이트되는 제품의 새로운 데이터로 채워집니다 (아래 코드 참조).

Sub GetDataFromClosedWorkbook() 
'Created by XXXX 5/2/2014 
Application.ScreenUpdating = False ' turn off the screen updating 

Dim wb As Workbook 
Set wb = Workbooks.Open("LOCATION OF FILE", True, True) 
' open the source workbook, read only 
With ThisWorkbook.Worksheets("1") 
' read data from the source workbook: (Left of (=) is paste @ destination, right of it is copy) 
.Range("F8:K25").Value = wb.Worksheets("1").Range("F8:K25").Value 
End With 

With ThisWorkbook.Worksheets("2") 
' read data from the source workbook: (Left of (=) is paste @ destination, right of it is copy) 
.Range("V5:Z359").Value = wb.Worksheets("2").Range("V5:Z359").Value 
End With 

wb.Close False ' close the source workbook without saving any changes 
Set wb = Nothing ' free memory 
Application.ScreenUpdating = True ' turn on the screen updating 

End Sub 

제가하는 데 문제는 이것이다 : 모든 한 번 잠시, 나는 (이 그냥 데이터를 추가로 반대 마스터에 행을 추가하는 새로운 제품을 추가해야합니다 행 전체에 추가됨). 때로는이 행이 끝에 있으며 때로는 중간에 있습니다. 아래 코드에서 볼 수 있듯이, VBA는 현재 미리 정의 된 범위에서 복사/붙여 넣기 만하므로이 행 변경을 처리 할 수 ​​없습니다. 각 사용자의 통합 문서는 행 #에서이 변경 사항을 인식하지 않으므로 열의 데이터가 잘못된 행과 연관됩니다. 일반적으로 전체 시트를 복사하고 문제를 해결할 수 있습니다. 내가 가진 문제는 각 사용자가 자신의 데이터를 옆에있는 자신의 통합 문서에 자신의 프로세스를 기록 할 수 있어야한다는 것입니다. 마스터 시트의 새 행이 각 사용자가 만든 표시를 지우거나 이동하지 않고 다른 모든 행에 추가되고 추가되도록 코드를 작성하는 방법이 있습니까? 나는 이것이 데이터를 보존 할 것이기 때문에 마스터에서 새로운 것이라면 행을 "삽입"하는 방법을 찾으려고 노력했지만 그걸 알아낼 수는 없다. 또한 워크 북에서 서버의 보안으로 인해 워크 북을 연결하는 등의 작업은 옵션이 아닙니다. 아무도 이것에 어떤 생각을 가지고 있습니까?

Answer 1

이 문제에 접근하는 한 가지 방법은 Scripting.Dictionary 개체를 사용하는 것입니다. 대상 식별자와 원본 식별자에 대한 사전을 만들어 비교할 수 있습니다. 이 작업을 수행하기 위해 키 - 값 쌍이 실제로 필요하지 않다고 생각되지만 희망 사항은 올바른 방향으로 연결됩니다!

Sub Main() 

Dim source As Worksheet 
Dim target As Worksheet 
Dim dictSource As Object 
Dim dictTarget As Object 
Dim rng As Range 
Dim i As Integer 
Dim j As Integer 
Dim idSource As String 
Dim idTarget As String 
Dim offset As Integer 

Set source = ThisWorkbook.Sheets(2) 
Set target = ThisWorkbook.Sheets(1) 

offset = 9 'My data starts at row 10, so the offset will be 9 

Set rng = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row) 
Set dictSource = CreateObject("Scripting.Dictionary") 
For Each cell In rng 
    dictSource.Add Key:=cell.Value, Item:=cell.Row 
Next 

Set rng = target.Range("A10:A" & target.Cells(target.Rows.Count, "A").End(xlUp).Row) 
Set dictTarget = CreateObject("Scripting.Dictionary") 
For Each cell In rng 
    dictTarget.Add Key:=cell.Value, Item:=cell.Row 
Next 

i = 1 
j = source.Range("A10:A" & source.Cells(source.Rows.Count, "A").End(xlUp).Row).Rows.Count 
Do While i <= j 
Retry: 
    idSource = source.Cells(i + offset, 1).Value 
    idTarget = target.Cells(i + offset, 1).Value 
    If Not (dictSource.Exists(idTarget)) And idTarget <> "" Then 
     'Delete unwanted rows 
     target.Cells(i + offset, 1).EntireRow.Delete 
     GoTo Retry 
    End If 
    If dictTarget.Exists(idSource) Then 
     'The identifier was found so we can update the values here... 
     dictTarget.Remove (idSource) 
    ElseIf idSource <> "" Then 
     'The identifier wasn't found so we can insert a row 
     target.Cells(i + offset, 1).EntireRow.Insert 
     'And you're ready to copy the values over 
     target.Cells(i + offset, 1).Value = idSource 
    End If 
    i = i + 1 
Loop 

Set dictSource = Nothing 
Set dictTarget = Nothing 

End Sub