Excel宏转置只有几列

Question

我有一个excel表看起来像这样：“Sheet1”和“Sheet2”，我希望结果如“Sheet3”所示。

Sample Data

最后我想在一个单独的工作表（控制面板）中放一个“按钮”，当点击它时，我需要将“Sheet1”和“Sheet2”中的数据与转置效果结合起来，如“Sheet3”所示。

如何使用宏自动执行此操作，因为在Sheet 1中有~2000“行”，在Sheet 2中有~1000。我是宏的新手，所以希望我可以自动化，否则我会手动复制和粘贴所有这些。

谢谢！

Answer 1

使用返回工作表最后一行的函数可能会有所帮助：

Public Function funcLastRow(shtTarget As Worksheet, Optional iColLimit As Integer = -1) As Long

    If iColLimit = -1 Then
        iColLimit = 256
    End If

    Dim rowMaxIndex As Long
    rowMaxIndex = 0

    Dim ctrCols As Integer
    For ctrCols = 1 To iColLimit
    If shtTarget.Cells(1048576, ctrCols).End(xlUp).Row > rowMaxIndex Then
            rowMaxIndex = shtTarget.Cells(1048576, ctrCols).End(xlUp).Row
        End If
    Next ctrCols

    funcLastRow = rowMaxIndex

End Function

您可以像这样使用它：

Dim lLastRow As Long
lLastRow = funcLastRow(Sheets(1))

如果这对你有用，请告诉我们

Answer 2

这是一个全配方解决方案（无宏）

数据在Sheet1 A到I和Sheet2 A到G中

我假设你只有6个部门。虽然如果你有额外的，公式需要很少或可能没有修改。

在表3中

获取用户ID重复六次

A2 = INDEX(Sheet1!A:A,1+QUOTIENT(ROW()-ROW($A$2)+6,6))

获取姓名，性别和国家

B2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:B$1),FALSE)

C2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:C$1),FALSE)

D2 = VLOOKUP($A2,Sheet1!$A$2:$I$3000,COLUMNS($A$1:D$1),FALSE)

获得部门访问权限。如果得到的细胞是空白的，则"" & ...应避免为0。

E2 = "" & IF(SUMPRODUCT(--(Sheet1!$A$1:$I$1=F2))>0,HLOOKUP(F2,Sheet1!$A$1:$I$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0),FALSE),HLOOKUP(F2,Sheet2!$A$1:$G$3000,MATCH(A2,Sheet2!$A$1:$A$3000,0),FALSE））

F2:F7部门是手动输入（没有公式）。 F8与F2相关联，以便在拖下时重复部署

G2 = "" & IF(SUMPRODUCT(--(Sheet1!$A$1:$I$1=F2))>0,INDEX(Sheet1!$I$1:$I$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0)),INDEX(Sheet2!$G$1:$G$3000,MATCH(A2,Sheet1!$A$1:$A$3000,0)))

如果您需要，我可以准备一个谷歌表演示。干杯。

Answer 3

此代码适用于Transpose和大数据的连接。

Sub ConcatData()
Dim X As Double
Dim DataArray(5000, 2) As Variant
Dim NbrFound As Double
Dim Y As Double
Dim Found As Integer
Dim NewWks As Worksheet

Cells(1, 1).Select
Let X = ActiveCell.Row
Do While True
If Len(Cells(X, 1).Value) = Empty Then
Exit Do
End If
If NbrFound = 0 Then
NbrFound = 1
DataArray(1, 1) = Cells(X, 1)
DataArray(1, 2) = Cells(X, 2)
Else
For Y = 1 To NbrFound
Found = 0
If DataArray(Y, 1) = Cells(X, 1).Value Then
DataArray(Y, 2) = DataArray(Y, 2) & ", " & Cells(X, 2)
Found = 1
Exit For
End If
Next
If Found = 0 Then
NbrFound = NbrFound + 1
DataArray(NbrFound, 1) = Cells(X, 1).Value
DataArray(NbrFound, 2) = Cells(X, 2).Value
End If
End If
X = X + 1
Loop

Set NewWks = Worksheets.Add
NewWks.Name = "SummarizedData"
Cells(1, 1).Value = "Names"
Cells(1, 2).Value = "Results"
X = 2
For Y = 1 To NbrFound
Cells(X, 1).Value = DataArray(Y, 1)
Cells(X, 2).Value = DataArray(Y, 2)
X = X + 1
Next
Beep
MsgBox ("Summary is done!")
End Sub