在Excel中製作垂直水平列表

我需要將垂直水平列表的一部分變成垂直。我嘗試過使用TRANSPOSE沒有任何成功。在Excel中製作垂直水平列表

使用一個VBA腳本我在四位或五位數產品號下插入了空行。我想移動（或複製/粘貼）圖像中顯示的值。

Excel列表

我修改給我（給TheAtomicOption信貸）一個VBA腳本，但Excel的攤位，當我運行它：如何

Sub Sizes() 

'figure out how far down data goes 
Range("A1").Select 
Selection.End(xlDown).Select 
Dim endrow 
endrow = Selection.Row 

'always start in the correct column 
Range("D1").Select 
Selection.End(xlDown).Select 
ActiveCell.Offset(0, -1).Activate 

Dim rownumber 

'loop through all data 
Do While ActiveCell.Row < endrow 
    'Store cell of current base name 
    rownumber = ActiveCell.Row 


    'loop through empty cells and set formula if cell isn't empty 
    Do While True 
     ActiveCell.Offset(1, 0).Activate 

     'if next cell isn't empty, isn't past the end of the list, go to outer loop 
     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=E(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=F(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=G(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=H(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Offset(0, 1).Formula = "=I(" & rownumber & ")" 
     ActiveCell.Offset(1, 0).Activate 

     Else 
      Exit Do 
     End If 
     End If 
     End If 
     End If 
     End If 

    Loop 
Loop 

End Sub

任何建議解決，以及如何改進腳本？

編輯：列A只是一個支持列Selection.End(xlDown).Select 列B是大小的計數器。它用於插入新行的初始腳本。 C列是SKU /產品ID D列是我希望列出所有尺寸的列。 E-I列和具有SKU的行是現在列出尺寸的地方。

最終的結果應該如何看待

編輯2：QHarr

解決方案，這要歸功於劇本。

Option Explicit 

Sub Sizes() 
Dim wb As Workbook 
Dim ws As Worksheet 

'figure out how far down data goes 
Dim endrow As Long 
Dim rownumber As Long 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("Sheet1") ' Modified the sheet name 

With ws 
    endrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    'always start in the correct column 
    .Cells(.Cells(1, "D").End(xlDown).Row, "D").Offset(, -1).Activate 

    'loop through all data 
    Do While ActiveCell.Row < endrow 

     'loop through empty cells and set formula if cell isn't empty 
     Do While ActiveCell.Row <= endrow 

     'Set rownumer at new product id 

     rownumber = ActiveCell.Row 

      ActiveCell.Offset(1, 0).Activate 

      'if next cell isn't empty, isn't past the end of the list, go to outer loop 
      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=E" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=F" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=G" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=H" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
       ActiveCell.Offset(0, 1).Formula = "=I" & rownumber 
       ActiveCell.Offset(1, 0).Activate 

      Else 
       Exit Do 
      End If 
      End If 
      End If 
      End If 
      End If 
     Loop 
    Loop 

End With 

End Sub

來源

2017-09-29 hedburgaren

一些出發點：如果您有明確的選項，那麼由於未聲明變量類型昏暗的傍should應該像黯淡的長something一樣長。另外，根據數據的結構（列中是否有空白），您可能需要修改如何找到最終行。通過拖延，你的意思是說它不停地運行？這可能意味着您的Do Loop沒有退出條件，或者沒有達到此條件。還是有錯誤信息給出？ – QHarr

如何提供實際原始數據的屏幕截圖以及期望的結果？ –

@QHarr：列中沒有空白。雖然在行中有差距。通過拖延我的意思是腳本繼續運行，屏幕變成灰色，我收到了Excel不再響應的消息。 – hedburgaren

我還沒有優化此代碼，但看看這是否工作。我已經添加了對工作簿和目標工作表的引用。您需要修改您的目標工作表名稱。

，聲明爲數據類型增加了變數。

單個DO循環與退出條件，可以得到滿足。

更正語法和除去每個具有以下格式的線的偏移量： ActiveCell.Offset（0，1）.Formula = 「= E（」 & ROWNUMBER & 「）」

你需要ActiveCell。公式=「= E」 & ROWNUMBER

注：我假設你是一個循環，所以列只有一個循環需要。原代碼，你會需要做2圈雖然ActiveCell.Row < endrow兩個循環和ActiveCell.Formula =「= E」 & ROWNUMBER + 1等。

Option Explicit 

Sub Sizes() 
Dim wb As Workbook 
Dim ws As Worksheet 
Dim endrow As Long 
Dim rownumber As Long 

Set wb = ThisWorkbook 
Set ws = wb.Sheets("TargetSheetName") 

With ws 

    'figure out how far down data goes (assuming last row in A is also last in D) 
    endrow = .Cells(.Rows.Count, "A").End(xlUp).Row 

    'always start in the correct column 
    .Cells(.Cells(1, "D").End(xlDown).Row, "D").Offset(-1, 0).Activate 

    'loop through all data 
    Do While ActiveCell.Row < endrow 
     'Store cell of current base name 
     rownumber = ActiveCell.Row 
     ActiveCell.Offset(1, 0).Activate 

     'if next cell isn't empty, isn't past the end of the list, go to _ 
    outer loop 
     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=E" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=F" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=G" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=H" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     If ActiveCell.Formula = "" And ActiveCell.Row <= endrow Then 
      ActiveCell.Formula = "=I" & rownumber 
      ActiveCell.Offset(1, 0).Activate 

     Else 
      Exit Do 
     End If 
     End If 
     End If 
     End If 
     End If 
     Loop 
End With 

End Sub

來源

2017-09-29 14:06:59 QHarr

需要一些tweeking，但它做到了！謝謝！我用更新後的代碼更新了我原來的帖子。 – hedburgaren