使用 forloops vba-excel 将数据转换为面板格式

Converting data to panel format using forloops vba-excel

我的数据集如下所示:

AUS, UK, USA, GERMANY, FRANCE, MEXICO, DATE
R1, R1,   R1,    R1  ,   R1  , R1    ,  1
R2, R2,   R2,    R2  ,   R2  , R2    ,  2
...

等等。我想将其转换为

COUNTRY, RETURNS, DATE, 
AUS,     R1,       1
AUS,     R2,       2
...,    ...,     ...,
UK,     R1,        1,
UK,     R2,        2,
...     ...      ...,
MEXICO, R1,        1,
MEXICO, R2,        2,
...     ...      ...

我觉得这应该可以通过简单的嵌套 forloop 实现。

我试过:

    sub panel()
'dim variables
Dim i As Integer
Dim j As Integer
Dim reps As Integer
Dim country As String
Dim strfind As String
Dim obs As Integer

'count the number of countries
reps = Range("D1:AL1").Columns.Count

'count the number of observations per country
obs = Range("C4:C5493").Rows.Count

'copy and paste country into panel format
For i = 1 To reps
    'set country name
    country =Range("D1").Cells(1, i)
    For j = 1 To obs
    'copy and paste country values
    Range("AS2").Cells(j, 1) = country
    Next j
Next i

但在 j 次循环完成并设置新的国家/地区名称后,新值将替换第一批单元格中的旧值。

好的,我修好了。可能不是最好的代码,但它有效:)。

Sub replicate_dates()
'declare variables
Dim i As Double
Dim j As Double
Dim reps As Integer
Dim country As String
Dim strfind As String
Dim obs As Integer
'set strfind value
strfind = "-DS Market"

'count the number of countries
reps = Range("D1:AL1").Columns.Count

'count the number of observations per country
obs = Range("C4:C5493").Rows.Count

i = 0
'copy and paste country into panel format
For k = 1 To reps
    'set country name and clean string
    country = Replace(Range("D1").Cells(1, k), strfind, "")
    For j = i + 1 To obs + i
    'copy and paste country values
    Range("AS5").Cells(i, 1) = country
    i = 1 + i
    Next j

Next k

结束子

编辑:Nvm,这在非常特殊的情况下不起作用。

考虑一个 SQL 解决方案,使用 UNION 查询 select 每列的长格式。如果在 PC 上使用 Excel,Excel 可以通过 ADO 和 运行 [=] 连接到 Jet/ACE SQL 引擎(Windows .dll 文件) 29=] 查询当前工作簿的工作表。

使用这种方法,您可以避免任何 for 循环、嵌套 if/then 逻辑和其他数据操作需要以获得所需的输出。下面的示例假设数据位于名为 DATA 的选项卡和一个名为 RESULTS.

的空选项卡中
Sub RunSQL()    
    Dim conn As Object, rst As Object
    Dim strConnection As String, strSQL As String
    Dim i As Integer

    Set conn = CreateObject("ADODB.Connection")
    Set rst = CreateObject("ADODB.Recordset")

    ' CONNECTION STRINGS (TWO VERSIONS)
'    strConnection = "DRIVER={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" _
'                      & "DBQ=C:\Path\To\Workbook.xlsm;"
    strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" _
                       & "Data Source='C:\Path\To\Workbook.xlsm';" _
                       & "Extended Properties=""Excel 8.0;HDR=YES;"";"        
    strSQL = " SELECT 'AUS' AS COUNTRY, AUS AS RETURNS, [DATE] FROM [DATA$]" _
            & " UNION ALL SELECT 'UK', UK AS Country, [DATE] FROM [DATA$]" _
            & " UNION ALL SELECT 'USA', USA AS Country, [DATE] FROM [DATA$]" _
            & " UNION ALL SELECT 'GERMANY', GERMANY AS Country, [DATE] FROM [DATA$]" _
            & " UNION ALL SELECT 'FRANCE', FRANCE AS Country, [DATE] FROM [DATA$]" _
            & " UNION ALL SELECT 'MEXICO', MEXICO AS Country, [DATE] FROM [DATA$];"

    ' OPEN CONNECTION & RECORDSET
    conn.Open strConnection
    rst.Open strSQL, conn

    ' COLUMN HEADERS
    For i = 1 To rst.Fields.Count
        Worksheets("RESULTS").Cells(1, i) = rst.Fields(i - 1).Name
    Next i        
    ' DATA ROWS
    Worksheets("RESULTS").Range("A2").CopyFromRecordset rst

    rst.Close: conn.Close    
    Set rst = Nothing: Set conn = Nothing    
End Sub

输出

COUNTRY     RETURNS     DATE
AUS         R1          1
AUS         R2          2
UK          R1          1
UK          R2          2
USA         R1          1
USA         R2          2
GERMANY     R1          1
GERMANY     R2          2
FRANCE      R1          1
FRANCE      R2          2
MEXICO      R1          1
MEXICO      R2          2