Question

我有数千行数据，如下面的Excel示例＃1所示。所有数据目前都在A栏中。每个＆＃34;组＆＃34;数据有六行：名称，日期，城市，县，州和空白行。我需要将列A中每个名称下的数据移动到列B到E中，如第1行和第2行所示。然后我需要删除每个名称下面的五行以使单元格向上，以便最终输出看起来像数据目前在第1行和第2行。

Sub Move_Rows()
'
' Move_Rows Macro
' Moves cemetery row data for each grave into separate columns
'
' Keyboard Shortcut: Ctrl+q
'
    Range("A111:A115").Select
    Selection.Copy
    Range("B110").Select
    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Range("A111:A115").Select
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlUp
End Sub

以下是我为移动数据而创建的Excel 2010宏。问题是我无法弄清楚如何更改“范围”以便它获取下一组数据。我的公式仅适用于宏中指定范围内的数据。

library(raster)
b <- brick('file.nc')
be <- crop(b, extent(-85, -78, 45, 50))
a <- aggregate(be, dim(be)[2:1], na.rm=TRUE)
v <- values(a)
write.csv(v, 'precip.csv', row.names=FALSE)

Answer 1

奇怪，这还没有回答。：）

您只需要将逻辑放入循环中，我更喜欢使用Do..While...loop，所以我们在这里：

Sub Move_Rows()
'
' Move_Rows Macro
' Moves cemetery row data for each grave into separate columns
'
' Keyboard Shortcut: Ctrl+q
'
    Application.ScreenUpdating = False

    i = 111 'Initial row number
    Do While Cells(i, "A") <> ""
        Range(Cells(i, "A"), Cells(i+4, "A")).Select
        Selection.Copy
        Cells(i-1, "B").Select
        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Range(Cells(i, "A"), Cells(i+4, "A")).Select
        Application.CutCopyMode = False
        Selection.Delete Shift:=xlUp
        i = i + 1
    loop

    Application.ScreenUpdating = True
End Sub

祝你好运！

Answer 2

即使您添加新数据，也应该能够多次运行。我没有测试过，所以请谨慎行事。

Sub Move_Rows()
    Dim ws As Worksheet
    Dim rRng As Range ' keep track of where we're gonna paste the results
    Dim sRng As Range, eRng As Range ' start-range, end-range

    Set ws = ThisWorkbook.Worksheets(1) ' <~~ Change to whatever you need

    For i = 1 To ws.UsedRange.Rows.Count
        ' Is this row valid as start of a range? If the cell in col B is populated, this means the current row is already correctly "formatted" and we need to skip it.
        If (ws.Range("B" & i).Value = "") And (sRng Is Nothing) Then
            Set rRng = ws.Range("B" & i)
            Set sRng = ws.Range("A" & i).Offset(1, 0) ' start-range set to the row below, we don't need to transpose the name.
        End If

        ' Is this row valid as end of a range? If the cell in col A is empty, the previous range will be the end of the area we want to copy.
        If ws.Range("A" & i).Value = "" Then
            Set eRng = ws.Range("A" & i).Offset(-1, 0) ' end-range set to the row above, we don't want to transpose the empty cell.

            ' The row was empty and we've set the reference to the content above. Now we can delete the empty row.
            ws.Range("A" & i).EntireRow.Delete
        End If

        If (Not sRng Is Nothing) And (Not eRng Is Nothing) Then ' You can also move this inside the previous If-loop. I prefer having it outside for readability.
            ' We have both a start-range and an end-range, we should do the copy-paste now
            Range(sRng, eRng).Copy
            rRng.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True

            ' Delete the now-superfluous rows
            Range(sRng, eRng).EntireRow.Delete

            ' Empty the range variables so we don't get wrong matches next iteration.
            Set rRng = Nothing
            Set sRng = Nothing
            Set eRng = Nothing
        Else
            ' One of the ranges are empty, so we'll do nothing. You can remove this line and the Else.
        End If
    ' Go to the next row
    Next i
End Sub

将数据行移动到列，然后删除行

2 个答案: