宏複製和轉置每隔第七行和過去在新工作表

我有調查正在爲我的代理完成系統給我一個XML格式的報告。當我得到同樣的改變到Excel我得到在下文提到的格式宏複製和轉置每隔第七行和過去在新工作表

 
Survey number 
Agent Name 
Rating 1 
Rating 2 
Rating 3 
Rating 4 
Rating 5 
Comments

調查採用這種格式我每天大約700調查，我需要換位到下面提及的格式相同

 
Survey number/Agent Name/Rating 1/Rating 2/Rating 3/Rating 4/Rating 5/Comments

問題是宏繼續和文件變得沉重。

任何人都可以幫助宏如何檢測下一個調查，並自動從一張紙上覆制數據，然後在下一張紙上進行轉置，使其落在前面的一行之下。我對VB沒有太多的知識。

來源

2009-12-27 Shanky

Shanky，歡迎計算器！您可以編輯您的問題，並通過在4個空格處添加前綴（或選擇該行並按代碼示例按鈕）來格式化格式片段。使用預覽來查看它是否更易讀。 – 2009-12-27 10:00:55

你能否提供更多關於原始和轉置格式之間差異的信息？ – 2009-12-27 10:04:32

以下來源應該做你想做的。

它使用第一張作爲來源，第二張作爲目標。在片2

然後用在片材1的所有線環的第一列的第一個空細胞

第一搜索和複製數據，直到找到一個空的調查編號。原始數據不會被刪除，取消註釋一行以實現此目的（請參閱源文件）。

Sub transpose() 
    Dim sourceRow, targetRow, targetColumn As Integer 

    ' find first empty row in target sheet 
    targetRow = 1 
    While (Sheets(2).Cells(targetRow, 1) <> "") 
     targetRow = targetRow + 1 
    Wend 

    sourceRow = 1 
    While (Sheets(1).Cells(sourceRow, 1) <> "") 
     For targetColumn = 1 To 8 
      ' copy 
      Sheets(2).Cells(targetRow, targetColumn) = Sheets(1).Cells(sourceRow, 1) 
      ' delete original row (uncomment if required) 
      ' Sheets(1).Cells(sourceRow, 1) = "" 
      sourceRow = sourceRow + 1 
     Next targetColumn 
     targetRow = targetRow + 1 
    Wend 
End Sub

來源

2009-12-27 13:04:17

這裏的另一種方式，只是一個單一回路

Public Sub TransposeData() 
Dim LastRow As Long 
Dim NextRow As Long 
Dim i As Long 

    Application.ScreenUpdating = False 
    With Worksheets("Sheet1") 

     LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row 
     For i = 1 To LastRow Step 8 

      .Cells(i, "A").Resize(8).Copy 
      NextRow = NextRow + 1 
      .Cells(NextRow, "B").PasteSpecial Paste:=xlPasteAll, transpose:=True 
     Next i 

     .Rows(NextRow + 1).Resize(LastRow - NextRow).Delete 
     .Columns(1).Delete 
    End With 

    Application.ScreenUpdating = True 
End Sub

來源

2009-12-27 23:13:19

宏複製和轉置每隔第七行和過去在新工作表

回答

相關問題