0

我正在尝试获取一行数据并从中创建另一个工作表上的两个新行。

原始行将有 10 列，这些列基于从查找和表中派生的数据。

然后，我希望使用按特定顺序放置的某些单元格将这一行变为 2 行。

我已经使用录音机创建了一个 marco，但它只记录了记录的内容。我需要马可循环下一行所基于的工作表，直到它找到一个空白单元格然后停止。

示例原始表将具有：

aaa 98765 zx 1a23a xz date amount1 amount2 text 4567 1234

新表将有

aaa 98765 zx date amount1 text 1234
aaa 1a23a xz date amount2 text 4567

因此，如果原始工作表有 2 行，则工作表 2 将有 4 行，依此类推，那么当宏在原始工作表中遇到空白单元格时，它应该停止。

谁能建议我应该做些什么来做到这一点？

4

4 回答 4

1

见下文。期望数据从 A1 开始，我将结果输出到 N1。更改这些并添加相关的工作表引用：

Option Explicit
Option Base 1

Sub Process()

Dim dataInput() As Variant, dataOutput() As Variant
Dim i As Double

dataInput = Range("A1").CurrentRegion
ReDim dataOutput(UBound(dataInput, 1) * 2, 7)

    For i = 1 To UBound(dataInput) Step 2

        dataOutput(i, 1) = dataInput(1, 1)
        dataOutput(i, 2) = dataInput(1, 2)
        dataOutput(i, 3) = dataInput(1, 3)
        dataOutput(i, 4) = dataInput(1, 6)
        dataOutput(i, 5) = dataInput(1, 7)
        dataOutput(i, 6) = dataInput(1, 9)
        dataOutput(i, 7) = dataInput(1, 10)

        dataOutput(i + 1, 1) = dataInput(1, 1)
        dataOutput(i + 1, 2) = dataInput(1, 4)
        dataOutput(i + 1, 3) = dataInput(1, 5)
        dataOutput(i + 1, 4) = dataInput(1, 6)
        dataOutput(i + 1, 5) = dataInput(1, 8)
        dataOutput(i + 1, 6) = dataInput(1, 9)
        dataOutput(i + 1, 7) = dataInput(1, 11)

    Next i

Range("N1").Resize(UBound(dataOutput, 1), UBound(dataOutput, 2)) = dataOutput

End Sub
于 2012-12-04T12:41:11.243 回答
0

让我们假设您的数据Worksheet 1从单元格 A1 开始。此代码将向下移动每一行，直到没有数据剩余并将其放入Worksheet 2.

Sub SplitRowData()
    Dim data as Range, item as range

    Set data = Worksheets(1).Range("A1:A" & Range("A1").End(xlDown).Row)

    For each item in data
        //Add code to work on each row - sample shown below
        With Worksheets(2)
            .Range("A1") = Range("A1")
        End With
    Next item
End Sub

这有帮助吗？我不确定您使用什么代码来拆分行。显示的样本已经看起来很复杂，可以缩小。

于 2012-12-04T13:07:48.677 回答
0

这是您的代码，我对其进行了测试，并且效果很好。

希望你的问题现在很清楚。

Sub RECOLOCATE()

Dim i, j As Integer

Dim LastCell As Long

LastCell = ThisWorkbook.Sheets("DataSheet").Range("A100000").End(xlUp).Row - 1

j = 0

For i = 0 To LastCell

    ThisWorkbook.Sheets("NewSheetAdd").Range("A1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("A1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("B1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("B1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("C1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("C1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("D1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("F1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("E1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("G1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("F1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("I1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("G1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("J1").Offset(i, 0).Value

j = j + 1

    ThisWorkbook.Sheets("NewSheetAdd").Range("A1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("A1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("B1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("D1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("C1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("E1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("D1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("F1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("E1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("H1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("F1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("I1").Offset(i, 0).Value
    ThisWorkbook.Sheets("NewSheetAdd").Range("G1").Offset(j, 0).Value _
    = ThisWorkbook.Sheets("DataSheet").Range("K1").Offset(i, 0).Value
j = j + 1

Next i

End Sub

如果需要更多帮助，请告诉我。

于 2012-12-04T12:11:59.227 回答
0

很难想象你真正需要做什么。所以我坚持这个要求——你想取一行并从中创建两行

看看下面的代码和结果：

代码：

Option Explicit

Sub blabla()

Dim rngMain As Range
Dim rngFinal As Range
Dim i, j, k, m As Integer
Dim varMain As Variant
Dim varFinal As Variant

Set rngMain = Sheets("Sheet1").Range("A2:B11")
varMain = rngMain.Value

'-- we set second arrays rows into two times of first array, columns remain the same
ReDim varFinal(LBound(varMain) To UBound(varMain) * 2, LBound(varMain, 2) To UBound(varMain, 2))

k = 1
j = 2

For i = LBound(varMain) To UBound(varMain)
 For m = LBound(varMain, 2) To UBound(varMain, 2)
    If k < UBound(varFinal) And j < UBound(varFinal) Then
    '-- here we are just adding the values as it is from input to output
    '-- so you can do any calculation that you need here

        varFinal(k, m) = varMain(i, m)
        varFinal(j, m) = varMain(i, m)
    Else
        Exit For
    End If
  Next m

    k = (i * 2) + 1 '-- 1 * 2 = 2 -> + 1 = 3 --> creating odd
    j = (i * 2) + 2  '-- 2 * 1 = 1 -> + 2 = 4 --> creating even
Next i

'output final array to sheet
Set rngFinal = Sheets("Sheet1").Range("D2")
rngFinal.Resize(UBound(varFinal), UBound(Application.Transpose(varFinal))) = varFinal

End Sub

结果：

在此处输入图像描述

如果您可以更清楚地了解在新的双排组中需要什么，我很乐意为您提供帮助。

于 2012-12-04T13:26:56.967 回答