使用Excel宏和VBA移动和添加单元格

时间:2014-05-02 22:18:05

标签: excel vba excel-vba

我是编写Excel宏的新手,我想知道我的代码有什么问题,我不断收到对象值错误。

代码应该做的是将数据分解为中间有空格的列,然后将左侧和左上角的值添加到新单元格中。例如:

启动数据

1    2
2    4
3    5
4    6
5    7
6    8
7    9

宏数据后

(制作新栏目)

1        2    
2        4    
3        5    
4        6    
5        7    
6        8    
7        9   

(成品)

1    1+0 = 1     2    2
2    1+2 = 3     4    6
3    2+3 = 5     5    9
4    7           6    11
5    9           7    13
6    11          8    15
7    13          9    17

代码:

Sub shift_and_add()

    For i = 1 To Selection.height

        'Easier to start shifting cell by cell to the right'
        For j = Selection.width To 1 Step (-1)

           'Offset each cell by 1'
            Cells(i, j).Offset(0, 1).Insert Shift:=xlToRight

            'add the left and top left values from the cell'
            v = v + x.Offset(0, -1).Value + x.Offset(-1, -1).Value

            'update the cell value'
            Cells(i, j).Value = v
        Next j
    Next i
End Sub

2 个答案:

答案 0 :(得分:0)

是的,x不存在,但v = v ...行正在尝试使用x的地址。

我做了一些可能适合你的代码的非常脏的例子。我假设您的数据在单元格A1中开始,但是您可以通过简单地调整顶部附近的Column和theRow值来简单地更改此代码(例如,如果您的数据在单元格D10中开始,那么theColumn = 4,theRow = 10)。

Sub shift_and_add_2()

Dim values As Range

'set starting column and starting row:
theColumn = 1
theRow = 1

Do 'loop for each original column of data:
    'reset iteration requirement:
    theNewCol = 0

    'get the next column of data, based on a) your starting column and row and then b) subsequent columns found later on:
    Set values = Range(Cells(theRow, theColumn).Address, Range(Cells(theRow, theColumn).Address).End(xlDown))

    If values.Height > 99999 Then 'perhaps only one value, so we'll curtail the range:
        Set values = Range(Cells(theRow, theColumn).Address)
    End If

    x = 0
    For Each cell In values
        If x = 0 Then 'is the first row, we'll check for subsequent columns:
            'if we find a subsequent column, we'll first insert a new column before doing sums:
            If cell(1, 2).Value <> "" Then
                cell(1, 2).EntireColumn.Insert
                'and the REQUIREMENT for another iteration of this loop is switched "on":
                theNewCol = 1
                'and the next data column address is established:
                theColumn = theColumn + 2
            End If
            'here we do the actual sum, and colour the result:
            cell(1, 2).Value = cell.Value
            cell(1, 2).Interior.ColorIndex = 45
            x = 1
        Else 'was not the first row, so we didn't need to check for subsequent columns,
                'AND our sum is a little different:
            cell(1, 2).Value = (cell.Value + cell(0, 1).Value)
            cell(1, 2).Interior.ColorIndex = 45
        End If
    Next

    'If there's no requirement for another iteration (i.e. we found no further data columns) then exit:
    If theNewCol = 0 Then Exit Do
Loop

End Sub

答案 1 :(得分:0)

Try this code


Sub D()
Dim rng As Range
Dim i As Integer
Dim j As Integer
i = 2
j = 1
Set rng = Range(Cells(1, 1).Address, Cells(1, 1).End(xlDown).Address)
Cells(1, 2).EntireColumn.Insert
For Each dng In rng
D = Cells(1, 2).Value
If D = "" Then
Cells(1, 2).Value = Cells(1, 2).Offset(0, -1).Value
Else
Cells(i, 2).Value = dng.Value + Cells(j, 1).Value
i = i + 1
j = j + 1
End If
Next dng
End Sub