这个任务的Excel技巧

我有一个excel的电子表格，这行：

COLUMN Value1.Value2.Value3 Value4.Value5.Value6 Value7.Value8.Value9 

在另一个电子表格中，我有一个名字简单的列表：

  COLUMN Name1 Name2 Name3 

而且，当然，这个清单是巨大的:)。

所以最后需要下面的spreasdsheet：

  COLUMN Value1.Name1.Value2.Value3 Value4.Name1.Value5.Value6 Value7.Name1.Value8.Value9 Value1.Name2.Value2.Value3 Value4.Name2.Value5.Value6 Value7.Name2.Value8.Value9 Value1.Name3.Value2.Value3 Value4.Name4.Value5.Value6 Value7.Name4.Value8.Value9 

我必须将列表中的名称与电子表格上的所有值复制为所有名称。

有没有办法自动做这个过程？ 手动过程需要几个小时才能完成，我认为有一个更明智的做法，虽然我不知道！ 🙂

在此先感谢您的帮助。

Answer 1

总是有一个“。” 值之间。

试试这个代码。 使用数组对于巨大的名称/值列表将会快得多：

 Sub test() Dim arrVal As Variant Dim arrNames As Variant Dim arrRes As Variant Dim v, n, k As Long 'change Sheet1 to suit With ThisWorkbook.Worksheets("Sheet1") 'change A1:A3 to values address arrVal = .Range("A1:A3") 'change B1:B3 to names address arrNames = .Range("B1:B3") ReDim arrRes(1 To UBound(arrVal) * UBound(arrNames), 1 To 1) k = 1 For Each v In arrVal For Each n In arrNames arrRes(k, 1) = Left(v, InStr(1, v, ".")) & n & Mid(v, InStr(1, v, ".")) k = k + 1 Next Next v 'change "c1" to start cell where to put new values .Range("C1").Resize(UBound(arrRes, 1)) = arrRes End With End Sub 

注意：如果您不知道“值”和“名称”范围的确切地址，请更改此部分

 'change A1:A3 to values address arrVal = .Range("A1:A3") 'change B1:B3 to names address arrNames = .Range("B1:B3") 

至

 'change A1:A to "values" address arrVal = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'change B1:B to "names" address arrNames = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row) 

在这种情况下，“值”和“名称”范围相应地从A1和B1开始，并相应地在Coumns A和B的最后一个非空行结束。

结果：

Answer 2

这是一个很好的挑战，做公式：:)

在D1中使用这个数组公式，然后复制下来

 =INDEX(LEFT($A$1:$A$4;FIND(".";$A$1:$A$4))&TRANSPOSE($C$1:$C$3)&RIGHT($A$1:$A$4;LEN($A$1:$A$4)-FIND(".";$A$1:$A$4)+1);1+INT((ROWS($D$1:D1)-1)/ROWS($C$1:$C$3));1+MOD(ROWS($D$1:D1)-1;ROWS($C$1:$C$3))) 

根据您的地区设置，您可能需要更换字段分隔符“;” 按“，”

Answer 3

我认为可以工作。

  Const FIRST_TALBE = 4 Const SECOND_TABLE = 2 Sub makeTheJob() For i = 1 To lastRow l = Split(Cells(i, FIRST_TABLE), ".") newvalue = l(0) & "." & Cells(i, SECOND_TABLE) & "." & l(1) & "." & l(2) Debug.Print newvalue Next i End Sub