这将扫描片叫“工作表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