빈 행으로 구분 된 행에 연속 셀이있는 Excel 파일이 있습니다. 예 : Name Adresse Tel Fax Web-EMPTY ROW-Name Adress1 Adress2 Tel Web-EMPTY ROW-...
각 연속 범위를 가져 와서 각 범위의 오른쪽에있는 열로 전치해야합니다. 실제로 손으로 범위를 선택하고 바로 가기 매크로를 실행하여 다음 코드로 전치해야합니다.
ActiveCell.Offset(0, 1).Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
vba에서 첫 번째 범위를 선택하고 조옮김 한 다음 빈 행 뒤의 다음 범위를 가져 와서 파일이 끝날 때까지 다시 조옮김하도록 도와 주실 수 있습니까?
어때? 귀하의 데이터가 다음과 같다고 가정합니다 (열 A 및 B)
Name Batman
Address 123 Batcave Drive
Phone 555-666-8888
Fax 555-666-8889
Web www.batman.com
Name 1 Superman
Address 1 321 Krypton Lane
Phone 1 555-777-5555
Fax 1 555-777-5556
Web 1 www.superman.com
이 매크로를 사용하면 C 열에서 시작하여 데이터가 전치됩니다.
Sub test()
Dim lastRangeRow As Integer, lastRow As Integer, i As Integer, copyCol As Integer
Dim noOfReports As Integer
copyCol = 2 'Column "B" has the info you want to transpose. Change if different
lastRow = Sheets("Sheet1").UsedRange.Rows.Count
' How many blank cells are there? This will tell us how many times to run the macro
noOfReports = Range(Cells(1, 1), Cells(lastRow, 1)).SpecialCells(xlCellTypeBlanks).Cells.Count + 1
i = 1
Do While i <= lastRow 'until you reach the last row, transpose the data
With Sheets("Sheet1")
lastRangeRow = .Cells(i, copyCol).End(xlDown).Row
.Range(.Cells(i, copyCol), .Cells(lastRangeRow, 2)).Copy
.Cells(i, copyCol + 1).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
If lastRangeRow >= lastRow Then
Exit Do
Else
i = .Cells(i, copyCol).End(xlDown).End(xlDown).Row
End If
End With
Loop
MsgBox ("Done!")
Application.CutCopyMode = False
End Sub
더 많은 정보를 제공하시면 조정할 수 있습니다. 마지막에 "B"열이 사라지기를 원하십니까? "헤더"( "이름", "주소", "전화"등)도 바꾸시겠습니까?
이 기사는 인터넷에서 수집됩니다. 재 인쇄 할 때 출처를 알려주십시오.
침해가 발생한 경우 연락 주시기 바랍니다[email protected] 삭제
몇 마디 만하겠습니다