Excel使用單獨的工作表中的列填充數據行

Question

我有一個帶有大量名爲「xxA」和「xxB」的工作表的Excel文件，其中xx是連續的數字。

每片具有以下格式：

header1  header2  header3  header 4  header5 
ingredient1 description xx   20   g 
ingredient2 description xx   34   ml 
ingredient3 description xx   56   g 

並在結束一些其他行。 基本上我想創建一個新的工作表，將D列中的第2-27行復制到名爲「value」的列中，並在工作表名稱中創建兩個帶有數字的新列，而另一個字母如下所示：

subject condition ingredient value 
21   A   ingredient1 20 
21   A   ingredient2 34 
21   A   ingredient3 56 
21   B   ingredient1 34 
21   B   ingredient2 23 
21   B   ingredient3 47 
... 

我試着弄透了數據透視表，但那並沒有真正奏效。我不知道如何創建一個VBA，所以如果這是唯一的出路，那麼任何方向都會很棒。

Answer 1

我想這就是你要找的。它從工作表中複製數據，並按照問題分解表單名稱。我把它硬編碼爲僅適用於兩位數字和單個字母。你有沒有適合這種形式的牀單？如果是這樣，我可以重寫我的代碼！

ORIGINAL：

Sub SheetSummary() 

'Make new worksheet with required headers 
ActiveWorkbook.Sheets.Add 
ActiveSheet.name = "Summary" 
range("A1").Value = "subject" 
range("B1").Value = "condition" 
range("C1").Value = "ingredient" 
range("D1").Value = "value" 

Dim ws As Worksheet 
Dim wsNum As String 
Dim wsLetter As String 
Dim wsLastRow As Long 
Dim sumLastRow As Long 
Dim myCell As range 
Dim nextOpenRow As Long 

'If a worksheet is not the summary, then get the data 
For Each ws In Worksheets 
    If ws.name <> "Summary" Then 
     wsNum = Left(ws.name, 2) 
     wsLetter = Right(ws.name, 1) 

     wsLastRow = ws.Cells(Rows.count, "A").End(xlUp).Row 
     nextOpenRow = Cells(Rows.count, "A").End(xlUp).Row + 1 

     ws.range("A2", ws.Cells(wsLastRow, "A")).Copy 

     range("C" & nextOpenRow).PasteSpecial xlPasteAll 

     lastRow = Cells(Rows.count, "C").End(xlUp).Row 

     ws.range("C2", ws.Cells(wsLastRow, "C")).Copy 

     range("D" & nextOpenRow).PasteSpecial xlPasteAll 

     Application.CutCopyMode = False 

     For Each myCell In range("A2", Cells(lastRow, "A")) 
      If myCell.Value = "" Then 
       myCell.Value = wsNum 
      End If 
     Next myCell 

     For Each myCell In range("B2", Cells(lastRow, "B")) 
      If myCell.Value = "" Then 
       myCell.Value = wsLetter 
      End If 
     Next myCell 
    End If 
Next ws 

End Sub 

編輯：

Sub SheetSummary() 

'Make new worksheet with required headers 
ActiveWorkbook.Sheets.Add 
ActiveSheet.name = "Summary" 
range("A1").Value = "subject" 
range("B1").Value = "condition" 
range("C1").Value = "ingredient" 
range("D1").Value = "value" 

Dim ws As Worksheet 
Dim wsNum As String 
Dim wsLetter As String 
Dim wsLastRow As Long 
Dim sumLastRow As Long 
Dim myCell As range 
Dim nextOpenRow As Long 

'If a worksheet is not the summary, then get the data 
For Each ws In Worksheets 
    If ws.name <> "Summary" Then 
     wsNum = Left(ws.name, 2) 
     wsLetter = Right(ws.name, 1) 

     wsLastRow = ws.Cells(Rows.count, "A").End(xlUp).Row 
     nextOpenRow = Cells(Rows.count, "A").End(xlUp).Row + 1 

     ws.range("A2:A27").Copy 

     range("C" & nextOpenRow).PasteSpecial xlPasteAll 

     lastRow = Cells(Rows.count, "C").End(xlUp).Row 

     ws.range("D2:D27").Copy 

     range("D" & nextOpenRow).PasteSpecial xlPasteAll 

     Application.CutCopyMode = False 

     For Each myCell In range("A2", Cells(lastRow, "A")) 
      If myCell.Value = "" Then 
       myCell.Value = wsNum 
      End If 
     Next myCell 

     For Each myCell In range("B2", Cells(lastRow, "B")) 
      If myCell.Value = "" Then 
       myCell.Value = wsLetter 
      End If 
     Next myCell 
    End If 
Next ws 

End Sub 

Answer 2

因爲你不知道VBA我不會建議採取這一路線。你可以使用Excel公式來實現你想要的一切。

要獲得片所使用的名稱：

=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255) 

替換爲「A1」與你想要的名稱，工作表上的單元格的引用。

然後使用Left()功能打出名稱中使用「XX」，然後使用Right()功能打出「A」

希望這有助於。