[已解决]如何复制并清除 内容

ls

写一代码要实现下面的功能：
                 将费用类别下的空格用左面一列的数值填充，然后将费用类别下的数据剪切粘到左面一列相应的位置上，此时数据为数值，
最后清除费用类别下的数据
不知我说明白了吗

最佳答案

月排行榜 / 总排行榜

放浪形骸

2011-3-28 21:30

那就进行了下修改。
这个代码放在SHEET1的模块里

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. Dim iCurRow As Integer
   
4. Dim iReturn As Integer
   
5. Dim iLeibie As Integer
   
6. Dim iRows As Integer
   
7. iCurRow = Target.Row
   
8. If Target.Count = 1 And Cells(1, Target.Column) = "费用类别" Then
   
9. iReturn = MsgBox("是否选择进行数据转换", 36, "需要转换数据么？")
   
10.     If iReturn = 6 Then
    
11.         iRows = Range("A65536").End(xlUp).Row
    
12.         iLeibie = Target.Column
    
13.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
    
14.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).Copy
    
15.         Range(Cells(iCurRow, iLeibie - 1), Cells(iRows, iLeibie - 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
16.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).Delete xlToLeft
    
17.     End If
    
18. End If
    
19. End Sub

复制代码

当你点的在“费用类别”那行的时候提示你需要数据转换否，如果是，则进行数据转换。

跳转到最佳答案楼层

ls

放浪形骸

我来回答吧：

1. 
   
2. Sub DeletClass()
   
3. Dim iLeiBie As Integer
   
4. Dim iRows As Integer
   
5. Dim i As Integer
   
6. iRows = Range("A65536").End(xlUp).Row
   
7. '查找“费用类别”所在的列
   
8. For i = 1 To 255
   
9.     If Cells(1, i).Value = "费用类别" Then
   
10.         iLeiBie = i
    
11.         Exit For
    
12.     End If
    
13. Next
    
14. '选择“费用类别”里的空值
    
15. Columns(i).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
    
16. Range(Cells(2, iLeiBie), Cells(iRows, iLeiBie)).Copy
    
17. Range(Cells(2, iLeiBie - 1), Cells(2, iLeiBie - 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
18. Range(Cells(2, iLeiBie), Cells(iRows, iLeiBie)).Delete xlToLeft
    
19. End Sub

复制代码

我很偷懒地录制了下宏。

ls

放浪形骸 发表于 2011-3-28 01:39
我来回答吧：
我很偷懒地录制了下宏。

我也录制了宏，没会修改，没有达到我的目的

ls

Range(Cells(2, iLeiBie), Cells(iRows, iLeiBie)).Copy
顶点能不能我来选择，不一定是Cells(2, iLeiBie)

放浪形骸

那一列的名字是叫金额么？

ls

放浪形骸 发表于 2011-3-28 20:05
那一列的名字是叫金额么？

我要达到这样的要求：
                我在费用类别列选择range（中间的一个点到iROW），
然后将这一区域的空值等于左一列的值，复制range（中间的一个点到iROW），粘贴到左一列的位置
注意：中间一点到费用类别的区域不变

ls

也就是说，费用类别列选择range（中间的一个点到iROW），是我所选择的区域

ls

或者可以做个选择区域的 对话框，如下面的样式

放浪形骸

那就进行了下修改。
这个代码放在SHEET1的模块里

1. Option Explicit
   
2. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
3. Dim iCurRow As Integer
   
4. Dim iReturn As Integer
   
5. Dim iLeibie As Integer
   
6. Dim iRows As Integer
   
7. iCurRow = Target.Row
   
8. If Target.Count = 1 And Cells(1, Target.Column) = "费用类别" Then
   
9. iReturn = MsgBox("是否选择进行数据转换", 36, "需要转换数据么？")
   
10.     If iReturn = 6 Then
    
11.         iRows = Range("A65536").End(xlUp).Row
    
12.         iLeibie = Target.Column
    
13.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=RC[-1]"
    
14.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).Copy
    
15.         Range(Cells(iCurRow, iLeibie - 1), Cells(iRows, iLeibie - 1)).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
16.         Range(Cells(iCurRow, iLeibie), Cells(iRows, iLeibie)).Delete xlToLeft
    
17.     End If
    
18. End If
    
19. End Sub

复制代码

当你点的在“费用类别”那行的时候提示你需要数据转换否，如果是，则进行数据转换。