使用 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
我的数据集如下所示:
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