這將掃描片叫「工作表Sheet1」和輸出結果的表稱爲「Sheet2的」,我已經標在哪裏更改這些名稱所以你可以拒絕它爲你的需要:
Sub NeferZhang()
Dim Ws As Worksheet, _
Wop As Worksheet, _
Wrow As Integer, _
FirstRun As Boolean
FirstRun = True
'-------Change name here-------
Set Ws = ThisWorkbook.Sheets("Sheet1")
'-------Change name here-------
Set Wop = ThisWorkbook.Sheets("Sheet2")
Wop.Cells.ClearContents
Wop.Cells.ClearFormats
For i = 1 To Ws.Range("A" & Ws.Rows.Count).End(xlUp).Row
For k = 3 To Ws.Range("A" & i).End(xlToRight).Column
Wrow = Wop.Range("A" & Wop.Rows.Count).End(xlUp).Row + 1
If Wrow <> 2 And Not FirstRun Then
'Nothing to change
Else
'Only change at the first try, to write on first row
Wrow = 1
FirstRun = False
End If
Wop.Range("C" & Wrow + (k - 3)).Value = Ws.Cells(i, k).Value
Next k
'Copy A and B columns
Wop.Range("A" & Wrow & ":B" & Wrow + (k - 4)).Value = Ws.Range(Ws.Cells(i, 1), Ws.Cells(i, 2)).Value
Next i
Set Ws = Nothing
Set Wop = Nothing
End Sub
你嘗試過什麼?你發佈的代碼並不多。你所有的價值都在不同的列上? – L42