如何将数据集指定列转换为行？求R或VBA实现代码

Absolutely! This is a classic "wide-to-long" data reshaping task, and both R and VBA have straightforward solutions. Below are step-by-step implementations for each tool:

R Solution #

The easiest way to do this in R is using the tidyr package's pivot_longer function (part of the tidyverse ecosystem). Here's how:

Step 1: Create Sample Data #

First, let's replicate your example dataset:

df <- data.frame(
  Id = c(1, 2),
  Name = c("Joe", "Sally"),
  year = c(2019, 2019),
  Offer1 = c("Army", "UA"),
  Offer2 = c("Navy", "UVA"),
  Offer3 = c("UGA", "UF")
)

Step 2: Reshape to Long Format #

Use pivot_longer to collapse the multiple Offer columns into a single column, repeating the Id, Name, and year values for each offer:

library(tidyr)

# Reshape the data
long_df <- pivot_longer(
  data = df,
  cols = starts_with("Offer"),  # Target all columns starting with "Offer"
  names_to = NULL,               # We don't need to keep the "Offer1/2/3" labels
  values_to = "Offer"            # Name of the new column for offers
)

# Reorder columns to match your desired output
long_df <- long_df[, c("Id", "Name", "year", "Offer")]

Result #

The output long_df will look exactly like your desired format:

Id  Name year Offer
1  1   Joe 2019  Army
2  1   Joe 2019  Navy
3  1   Joe 2019   UGA
4  2 Sally 2019    UA
5  2 Sally 2019   UVA
6  2 Sally 2019    UF

Alternative: Base R (No Packages Needed)

If you prefer not to use external packages, you can use base R's reshape function:

long_df_base <- reshape(
  df,
  direction = "long",
  varying = list(paste0("Offer", 1:3)),  # List of offer columns
  v.names = "Offer",                     # Name of new offer column
  idvar = c("Id", "Name", "year"),       # Columns to keep as identifiers
  times = NULL                           # Don't keep the "time" column
)
rownames(long_df_base) <- NULL  # Clean up auto-generated rownames

VBA Solution #

If you're working directly in Excel, this VBA macro will reshape your data automatically:

Step 1: Paste the Macro #

Open your Excel file, press Alt + F11 to open the VBA Editor, insert a new module, and paste this code:

Sub ReshapeOfferData()
    Dim sourceSheet As Worksheet
    Dim destSheet As Worksheet
    Dim lastSourceRow As Long
    Dim lastSourceCol As Long
    Dim sourceRow As Long
    Dim offerCol As Long
    Dim destRow As Long
    
    ' Set your source and destination sheets (adjust names if needed)
    Set sourceSheet = ThisWorkbook.Sheets("Sheet1")
    Set destSheet = ThisWorkbook.Sheets("Sheet2")
    
    ' Clear destination sheet and write headers
    destSheet.Cells.Clear
    destSheet.Range("A1:D1").Value = Array("Id", "Name", "year", "Offer")
    
    ' Find the last row and column in your source data
    lastSourceRow = sourceSheet.Cells(sourceSheet.Rows.Count, "A").End(xlUp).Row
    lastSourceCol = sourceSheet.Cells(1, sourceSheet.Columns.Count).End(xlToLeft).Column
    
    destRow = 2  ' Start writing data on row 2 of the destination sheet
    
    ' Loop through each row in the source data
    For sourceRow = 2 To lastSourceRow
        ' Loop through each Offer column (columns 4 to last column)
        For offerCol = 4 To lastSourceCol
            ' Only write if the offer cell isn't empty
            If sourceSheet.Cells(sourceRow, offerCol).Value <> "" Then
                destSheet.Cells(destRow, "A").Value = sourceSheet.Cells(sourceRow, "A").Value
                destSheet.Cells(destRow, "B").Value = sourceSheet.Cells(sourceRow, "B").Value
                destSheet.Cells(destRow, "C").Value = sourceSheet.Cells(sourceRow, "C").Value
                destSheet.Cells(destRow, "D").Value = sourceSheet.Cells(sourceRow, offerCol).Value
                destRow = destRow + 1
            End If
        Next offerCol
    Next sourceRow
    
    ' Auto-fit columns for readability
    destSheet.Columns.AutoFit
    
    MsgBox "Data reshaping finished successfully!", vbInformation
End Sub

Step 2: Run the Macro #

• Make sure your source data is in Sheet1 (adjust the sheet name in the code if yours is different)
• Press F5 in the VBA Editor to run the macro, or assign it to a button in Excel for easier access
• The reshaped data will appear in Sheet2

内容的提问来源于stack exchange，提问作者g_math_324