宏無需選擇CtrlC

Question

此宏只有在我從A22-78中選擇並按下C行時才起作用。 我希望它在沒有我這樣做的情況下工作。 此功能使一列從（#rows）*（＃列各行中）的

Sub RowsToColumn() 
Dim RN As Range 
Dim RI As Range 
Dim r As Long 
Dim LR As Long 
Dim WS As Worksheet 
Set WS = Sheets.Add 
Application.ScreenUpdating = False 

Columns(1).Insert 
r = 0 
LR = Range("B" & Rows.Count).End(xlUp).Row 
For Each RN In Range("B22:B" & LR) 
    r = r + 1 
    For Each RI In Range(RN, Range("XFD" & RN.Row).End(xlToLeft)) 
     r = r + 1 
     Cells(r, 1) = RI 
     RI.Clear 
    Next RI 
Next RN 
Columns("A:A").SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp 
Application.ScreenUpdating = True 
End Sub 

感謝ü

Answer 1

我嘗試了你的代碼，它似乎做的是讀出值從左到右依次放在A欄中。 這篇說明：

Sub Test() 

Dim oRange   As Range 
Dim oSheet   As Excel.Worksheet 
Dim vArray()  As Variant 

Dim lCnt_A   As Long 
Dim iCnt_B   As Integer 
Dim lCnt_C   As Long 
Dim iCnt_Cols  As Integer 


Set oSheet = ThisWorkbook.Sheets(1) 

Columns(1).Insert 
Set oRange = oSheet.UsedRange 
iCnt_Cols = oRange.Columns.Count 

vArray = oRange 
oRange.ClearContents 

For lCnt_A = 1 To UBound(vArray) 
    For iCnt_B = 1 To iCnt_Cols 
     lCnt_C = lCnt_C + 1 
     ThisWorkbook.Sheets(2).Cells(lCnt_C, 1).Value = vArray(lCnt_A, iCnt_B) 

    Next iCnt_B 
Next lCnt_A 

Set oSheet = Nothing 
Set oRange = Nothing 

End Sub 

請告訴我，如果我得到你的意圖錯誤。