Sub 询è¯å½()
Dim d As Range, Arr, m&, i&
Arr = Sheet2.[a2].CurrentRegion
Sheet3.Activate
Sheet3.Cells.Clear
Set d = Sheet1.[a1:i40]
m = 1
For i = 2 To UBound(Arr)
If Arr(i, 2) = "" Then Exit For
If Arr(i, 2) = "â" Then 'å¦æB3为âï¼åæ§è¡ä¸åç¨åº
d.Copy
Cells(m, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues
Selection.PasteSpecial Paste:=xlPasteColumnWidths
Selection.PasteSpecial Paste:=xlPasteFormats
Cells(m + 5, 1) = Arr(i, 3) & "ï¼" '模æ¿ä¸çA6çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸C3çå¼
Cells(m + 5, 6) = "åå½ç¼å·ï¼" & Arr(i, 1) '模æ¿ä¸çD5çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸A3çå¼
Cells(m + 14, 2) = Arr(i, 4) '模æ¿ä¸çB15çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸D3çå¼
Cells(m + 14, 4) = Arr(i, 5) '模æ¿ä¸çC15çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸E3çå¼
Cells(m + 14, 6) = Arr(i, 6) '模æ¿ä¸çD15çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸F3çå¼
Cells(m + 14, 8) = Arr(i, 7) '模æ¿ä¸çE15çå¼æ¯å¾æ¥ä¿¡æ¯è¡¨ä¸G3çå¼
End If
Rows(m + 1).RowHeight = 14.25
Rows(m + 3).RowHeight = 20.25
Rows(m + 7).RowHeight = 67.5
Rows(m + 19).RowHeight = 54
Rows(m + 9).RowHeight = 40.5
m = m + 42
'Range("a" & m - 1).Select
'ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
'ä¸ä¸ªåä½ç询è¯å½çæå®æ¯
Next
Application.ScreenUpdating = True
End Sub
温馨提示:答案为网友推荐,仅供参考