Excel 매크로에서 셀 크기 조정

Question

Excel 시트의 데이터를 연결하여 다른 시트에 복사 한 다음 다른 통합 문서로 복사하려고합니다. 데이터가 연속적이지 않아 필요한 반복 작업의 양을 알 수 없습니다.

지금이 코드의 일부는 아래와 같다 :

Sub GetCells() 
    Dim i As Integer, x As Integer, c As Integer 
    Dim test As Boolean 
    x = 0 
    i = 0 

test = False 
Do Until test = True 
Windows("Room Checksums.xls").Activate 

'This block gets the room name 
Sheets("Sheet1").Activate 
Range("B6").Select 
ActiveCell.Offset(i, 0).Select 
Selection.Copy 
Sheets("Sheet2").Activate 
Range("A1").Activate 
ActiveCell.Offset(x, 0).Select 
ActiveSheet.Paste Link:=True 

'This block gets the area 
Sheets("Sheet1").Activate 
Range("AN99").Select 
ActiveCell.Offset(i, 0).Select 
Selection.Copy 
Sheets("Sheet2").Activate 
Range("B1").Activate 
ActiveCell.Offset(x, 0).Select 
ActiveSheet.Paste Link:=True 

i = i + 108 
x = x + 1 
Sheets("Sheet1").Activate 
Range("B6").Activate 
ActiveCell.Offset(i, 0).Select 
test = ActiveCell.Value = "" 
Loop 

Sheets("Sheet2").Activate 
ActiveSheet.Range(Cells(1, 1), Cells(x, 12)).Select 
Application.CutCopyMode = False 
Selection.Copy 
Windows("GetReference.xlsm").Activate 
Range("A8").Select 
ActiveSheet.Paste Link:=True 

End Sub 

문제는 그것이 복사 과정에서 시트 사이 내리고, 하나 각 셀 하나 붙여된다는 것이다. 내가 뭘하고 싶은 건지, 108 세포에 의해 오프셋, 분산 된 세포의 번호를 선택하고 흩어져있는 세포 (크기 조정)의 다음 번호를 선택합니다.

이렇게하는 가장 좋은 방법은 무엇입니까?

Answer 1

매크로의 최종 결과를 연구했습니다. 내 목표는 기존 접근법을 정리하는 것이 아니라 그 결과를 달성하기위한보다 나은 접근 방법을 찾는 것입니다.

두 개의 통합 문서 이름을 "Room Checksums.xls"및 "GetReference.xlsm"이라고합니다. "xls"는 Excel 2003 통합 문서의 확장입니다. "xlsm"은 매크로가 포함 된 2003 년 이후 통합 문서의 확장입니다. 아마도이 확장을 올바르게 사용하고있을 것입니다.

Excel 2003을 사용하므로 모든 통합 문서의 확장명은 "xls"입니다. 나는 당신이 이것을 바꿀 필요가 있다고 생각합니다.

"Room Checksums.xls", "GetReference.xls"및 "Macros.xls"의 세 가지 통합 문서를 만들었습니다. "Room Checksums.xls"및 "GetReference.xls"에는 데이터 만 포함됩니다. 매크로는 "Macros.xls"에 있습니다. 권한이있는 사용자 만 매크로를 실행할 수 있고 일반 사용자가 매크로를 사용하거나 매크로에 액세스하지 못하도록 할 때이 부서를 사용합니다. 원하는 경우 아래의 내 매크로를 "GetReference.xls"내에서 변경하지 않고 배치 할 수 있습니다.

아래 이미지는 "Room Checksums.xls"의 워크 시트 "Sheet1"입니다. 대부분의 행과 열은 매크로와 관련이 없기 때문에 숨겨져 있습니다. 편의를 위해 셀 값을 주소로 설정했지만이 값에 다른 의미는 없습니다.

나는 매크로를 실행. "룸 Checksums.xls"의 "시트 2는"이되었다 :

참고 : 수식 입력 줄 =Sheet1!$B$6으로 셀 A1을 보여줍니다. 즉, 이것은 값이 아닌 링크입니다.

는 "GetReference.xls"의 활성 워크 시트가되었다 :

주 1 : 열 C의 제로가 L로 12 열을 이동하기 때문에 나는이 컬럼의 다른 데이터가 가정합니다. 당신이 원하는 당신 "룸 Checksums.xls"의 "시트 2"의

(주 2). 수식 입력 줄은 ='[Room Checksums.xls]Sheet2'!A1로 셀 A8을 보여줍니다

내 매크로는하지만 다소에서 당신과 같은 결과를 얻을 수있다. 다른 방식. 그러나, 설명 할 필요가있는 매크로에는 여러 가지 기능이 있습니다. 그것들은 꼭 필요한 것은 아니지만 그들이 훌륭한 습관을 대표한다고 믿습니다.

매크로에는 내가 말하는 마법의 숫자가 많이 포함되어 있습니다.예 : B6, AN99, 108 및 A8. 이 값들이 귀하의 회사에 의미가있을 수 있지만 현재 통합 문서의 사고라고 생각됩니다. 값 108을 여러 번 사용합니다. 이 값을 109로 변경하려면 코드를 108로 검색하고 109로 바꾸어야합니다. 108이라는 숫자는 다른 이유로 인해 코드에서 발생하지 않을 정도로 충분히 특이한 것이지만 다른 숫자는 그래서 특별하게 교체하는 것은 힘든 일입니다. 이 번호가 무엇을 의미하는지 바로 알 수 있습니다. 12 개월 후에이 매크로를 수정하기 위해 돌아 왔을 때 기억하십니까? 내가 상수로 (108)를 정의

:

Const Offset1 As Long = 108 

내가 더 나은 이름을 선호하지만이 숫자가 무엇인지 모른다. "Offset1"의 모든 항목을 좀 더 의미있는 이름으로 바꿀 수 있습니다. 또는 설명이 포함 된 설명을 추가 할 수도 있습니다. 값이 109가되면이 명령문을 한 번 변경하면 문제가 해결됩니다. 나는 내 이름의 대부분이 더 의미있는 것으로 대체되어야한다고 생각한다.

"Room Checksums.xls"및 "GetReference.xlsm"이 열려 있다고 가정합니다. 둘 중 하나가 열리지 않으면 해당 매크로가 해당 activate 문에서 중지됩니다. 아마도 이전 매크로가 이러한 통합 문서를 열었지만 열려 있는지 확인하기위한 코드를 추가했습니다.

내 매크로는 아무 것도 붙여 넣지 않습니다. B6, B114, B222, B330, B438, ... : 비어 있지 않은 마지막 순서에서 셀을 식별하는 "룸 Checksums.xls"의

• 일 아래 워크 시트 "Sheet1의를"의 세 가지 단계가 있습니다.

• "Room checksums.xls"의 워크 시트 "Sheet2"에서이 항목 (및 AN99 시리즈)에 대한 링크를 만듭니다. 수식은 "="기호로 시작하는 문자열이며 다른 문자열과 마찬가지로 만들 수 있습니다.

• "Room Checksums.xls"의 "Sheet2"테이블에있는 "GetReference.xls"의 워크 시트 "Xxxxxx"에 링크를 만듭니다. 올바른 워크 시트가 활성 상태인지 확인하는 것이 좋지 않습니다. 올바른 값 "XXXXXX". 내 매크로에서

내가 뭐하는 거지 설명하려고 시도했지만 내가 사용하고있는 문장의 구문에 대한 많은 말했다하지 않았습니다. 당신은 약간의 어려움이 설명을 찾을 수 있어야한다 문법을 이해하고 있지만 필요한 경우 질문하십시오.

내 문장이 혼란 스러울 것 같아요. 예를 들면 :

.Cells(RowSrc2Crnt, Col1Src2).Value = "=" & WshtSrc1Name & "!$" & Col1Src1 & _ 
              "$" & Row1Src1Start + OffsetCrnt 

워크 시트, 열 및 오프셋의 목적을 이해할 수 없기 때문에 원하는 이름만큼이나 의미가 없습니다. 복사 및 붙여 넣기 대신 "= Sheet1! $ B $ 6"과 같은 수식을 작성합니다. 나 자신을 위해 그것을 코딩 한 것 같이 내가 접근보다는 배열을 사용하는 것을 선호하기 때문에이 매크로는 확실히 아니다

"="        = 
WshtSrc1Name      Sheet1 
"!$"        !$ 
Col1Src1       B 
"$"        $ 
Row1Src1Start + OffsetCrnt  6 

: 당신이 표현을 통해 작업하는 경우에는 공식의 요소와 각 용어를 연관시킬 수 있어야한다 직접 워크 시트. 나는 배열을 추가하지 않고도 충분한 개념을 도입하기로 결정했다.

배열이 없어도이 매크로는 초보자가 코딩을 시작할 때 예상했던 것보다 더 이해하기가 어렵습니다. 그것은 세 가지 단계로 나뉘어 각각 조금씩 도움이되는 별개의 목적을 가지고 있습니다. 그것을 공부하면 통합 문서 형식이 변경되면 유지 보수가 더 쉬운 이유를 알기를 바랍니다.많은 양의 데이터가있는 경우이 매크로는 사용자의 데이터보다 훨씬 빠릅니다.

Option Explicit 

    Const ColDestStart As Long = 1 

    Const Col1Src1 As String = "B" 
    Const Col2Src1 As String = "AN" 

    Const Col1Src2 As String = "A" 
    Const Col2Src2 As String = "B" 
    Const ColSrc2Start As Long = 1 
    Const ColSrc2End As Long = 12 

    Const Offset1 As Long = 108 

    Const RowDestStart As Long = 8 
    Const Row1Src1Start As Long = 6 
    Const Row2Src1Start As Long = 99 

    Const RowSrc2Start As Long = 1 

    Const WbookDestName As String = "GetReference.xls" 
    Const WbookSrcName As String = "Room Checksums.xls" 

    Const WshtDestName As String = "Xxxxxx" 
    Const WshtSrc1Name As String = "Sheet1" 
    Const WshtSrc2Name As String = "Sheet2" 

Sub GetCellsRevised() 

    Dim ColDestCrnt As Long 
    Dim ColSrc2Crnt As Long 
    Dim InxEntryCrnt As Long 
    Dim InxEntryMax As Long 
    Dim InxWbookCrnt As Long 
    Dim OffsetCrnt As Long 
    Dim OffsetMax As Long 
    Dim RowDestCrnt As Long 
    Dim RowSrc2Crnt As Long 
    Dim WbookDest As Workbook 
    Dim WbookSrc As Workbook 

    ' Check the source and destination workbooks are open and create references to them. 

    Set WbookDest = Nothing 
    Set WbookSrc = Nothing 

    For InxWbookCrnt = 1 To Workbooks.Count 
    If Workbooks(InxWbookCrnt).Name = WbookDestName Then 
     Set WbookDest = Workbooks(InxWbookCrnt) 
    ElseIf Workbooks(InxWbookCrnt).Name = WbookSrcName Then 
     Set WbookSrc = Workbooks(InxWbookCrnt) 
    End If 
    Next 

    If WbookDest Is Nothing Then 
    Call MsgBox("I need workbook """ & WbookDestName & """ to be open", vbOKOnly) 
    Exit Sub 
    End If 

    If WbookSrc Is Nothing Then 
    Call MsgBox("I need workbook """ & WbookSrcName & """ to be open", vbOKOnly) 
    Exit Sub 
    End If 

    ' Phase 1. Locate the last non-empty cell in the sequence: B6, B114, B222, ... 
    ' within source worksheet 1 

    OffsetCrnt = 0 

    With WbookSrc.Worksheets(WshtSrc1Name) 
    Do While True 
     If .Cells(Row1Src1Start + OffsetCrnt, Col1Src1).Value = "" Then 
     Exit Do 
     End If 
     OffsetCrnt = OffsetCrnt + Offset1 
    Loop 
    End With 

    If OffsetCrnt = 0 Then 
    Call MsgBox("There is no data to reference", vbOKOnly) 
    Exit Sub 
    End If 

    OffsetMax = OffsetCrnt - Offset1 

    ' Phase 2. Build table in source worksheet 2 

    RowSrc2Crnt = RowSrc2Start 

    With WbookSrc.Worksheets(WshtSrc2Name) 
    For OffsetCrnt = 0 To OffsetMax Step Offset1 
     .Cells(RowSrc2Crnt, Col1Src2).Value = "=" & WshtSrc1Name & "!$" & Col1Src1 & _ 
              "$" & Row1Src1Start + OffsetCrnt 
     .Cells(RowSrc2Crnt, Col2Src2).Value = "=" & WshtSrc1Name & "!$" & Col2Src1 & _ 
              "$" & Row2Src1Start + OffsetCrnt 
     RowSrc2Crnt = RowSrc2Crnt + 1 
    Next 
    End With 

    ' Phase 3. Build table in destination worksheet 

    RowSrc2Crnt = RowSrc2Start 
    RowDestCrnt = RowDestStart 

    With WbookDest.Worksheets(WshtDestName) 
    For OffsetCrnt = 0 To OffsetMax Step Offset1 
     ColDestCrnt = ColDestStart 
     For ColSrc2Crnt = ColSrc2Start To ColSrc2End 
     .Cells(RowDestCrnt, ColDestCrnt).Value = _ 
       "='[" & WbookSrcName & "]" & WshtSrc2Name & "'!" & _ 
       ColNumToCode(ColSrc2Crnt) & RowSrc2Crnt 
     ColDestCrnt = ColDestCrnt + 1 
     Next 
     RowSrc2Crnt = RowSrc2Crnt + 1 
     RowDestCrnt = RowDestCrnt + 1 
    Next 
    End With 

End Sub 
Function ColNumToCode(ByVal ColNum As Long) As String 

    Dim Code As String 
    Dim PartNum As Long 

    ' Last updated 3 Feb 12. Adapted to handle three character codes. 
    If ColNum = 0 Then 
    ColNumToCode = "0" 
    Else 
    Code = "" 
    Do While ColNum > 0 
     PartNum = (ColNum - 1) Mod 26 
     Code = Chr(65 + PartNum) & Code 
     ColNum = (ColNum - PartNum - 1) \ 26 
    Loop 
    End If 

    ColNumToCode = Code 

End Function