將二維表轉換為單維表

將二維表轉換為單維表

我有一些與關稅代碼相關的產品價格數據:

+==============+========+========+========+========+
| product code | code10 | code20 | code30 | code40 |
|==============+========+========+========+========|
| product1     | 12.3   | 12.4   | 12.5   | 12.6   |
+--------------+--------+--------+--------+--------+
| product2     | 13.3   | 13.4   | 13.5   | 13.6   |
+--------------+--------+--------+--------+--------+
| product3     | 14.3   | 14.4   | 14.5   | 14.6   |
+--------------+--------+--------+--------+--------+

我想要一個包含三列的表格:產品代碼、價格和關稅代碼

+==============+=======+=============+
| product code | price | tariff code |
|==============+=======+=============+
| product1     | 12.3  | code10      |
+--------------+-------+-------------+
| product1     | 12.4  | code20      |
+--------------+-------+-------------+
| product1     | 12.5  | code30      |
+--------------+-------+-------------+
| product1     | 12.6  | code40      |
+--------------+-------+-------------+
| product2     | 13.3  | code10      |
+--------------+-------+-------------+
| product2     | 13.4  | code20      |
+--------------+-------+-------------+
| ........     | ....  | ......      |
+--------------+-------+-------------+
| product3     | 14.6  | code40      |
+--------------+-------+-------------+

我嘗試使用自訂貼上來實現此目的,但沒有成功。
有沒有辦法用 Calc 來做到這一點?

答案1

在OP的評論中,您提到使用腳本。該 VBa 執行此操作,將結果儲存到另一張表中。

即使您的電腦不支援 VBa,該腳本也可能會給您一個想法,以便您可以將其移植為您喜歡的語言。

請記住,使用 VBa,撤消通常不起作用,因此請先儲存檔案的副本作為備份!

Sub DoSomeMagic()

Call CreateHeadings

Dim row As Integer
row = 2

Dim sheet2row As Integer
sheet2row = 2

Do While (Worksheets("Sheet1").Range("A" & row).Value <> "")


Dim col As Integer
col = 66

    Do While (Worksheets("Sheet1").Range(Chr(col) & row).Value <> "")

        Worksheets("Sheet2").Range("A" & sheet2row).Value = Worksheets("Sheet1").Range("A" & row).Value
        Worksheets("Sheet2").Range("B" & sheet2row).Value = Worksheets("Sheet1").Range(Chr(col) & row).Value
        Worksheets("Sheet2").Range("C" & sheet2row).Value = Worksheets("Sheet1").Range(Chr(col) & 1).Value
           col = col + 1
           sheet2row = sheet2row + 1
    Loop

    row = row + 1

Loop

End Sub

Sub CreateHeadings()

Worksheets("Sheet2").Range("A1").Value = "product code"
Worksheets("Sheet2").Range("A1").Font.Bold = True
Worksheets("Sheet2").Range("B1").Value = "price"
Worksheets("Sheet2").Range("B1").Font.Bold = True
Worksheets("Sheet2").Range("C1").Value = "tariff code"
Worksheets("Sheet2").Range("C1").Font.Bold = True

End Sub

原件(表1)

在此輸入影像描述

運行VBa後,sheet2看起來像

在此輸入影像描述

相關內容