[已解决]我不会多个工作簿编码，想要批量把V列（第3行开始有数据的）乘以1.1，求教

qiaodong64

我不会多个工作簿编码，想要批量把V列（第3行开始有数据的）乘以1.1，求教

最佳答案

月排行榜 / 总排行榜

苏子龙

2017-1-9 18:20

Sub tt()
Dim Wb As Workbook, Sh As Worksheet, Wbnm As String
Dim Ends As Long, Mypath As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Mypath = ThisWorkbook.Path & "\"
Wbnm = Dir(Mypath & "*.xls*")
Do While Wbnm <> ""
    If Wbnm = ThisWorkbook.Name Then
    Set Wb = ActiveWorkbook
    Else
    Set Wb = Workbooks.Open(Mypath & Wbnm)
    End If
    For Each Sh In Wb.Worksheets
        Ends = Sh.Range("v65536").End(3).Row
        If Sh.Range("v2") <> "1次" Then
            Sh.Range("v2") = 1.1
            Sh.Range("v2").Copy
            Sh.Range("v3:v" & Ends).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
                    SkipBlanks:=False, Transpose:=False
            Sh.Range("v2") = "1次"
            Wb.Save
        End If
        If Wbnm <> ThisWorkbook.Name Then Wb.Close
        Wbnm = Dir
    Next
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set Wb = Nothing
End Sub
大概这样的把其中一个改成。xlsm格式，运行它，若另起一个工作簿，自己改改吧！

跳转到最佳答案楼层

苏子龙

Sub tt()
Dim Wb As Workbook, Sh As Worksheet, Wbnm As String
Dim Ends As Long, Mypath As String
Application.DisplayAlerts = False
Application.ScreenUpdating = False
Mypath = ThisWorkbook.Path & "\"
Wbnm = Dir(Mypath & "*.xls*")
Do While Wbnm <> ""
    If Wbnm = ThisWorkbook.Name Then
    Set Wb = ActiveWorkbook
    Else
    Set Wb = Workbooks.Open(Mypath & Wbnm)
    End If
    For Each Sh In Wb.Worksheets
        Ends = Sh.Range("v65536").End(3).Row
        If Sh.Range("v2") <> "1次" Then
            Sh.Range("v2") = 1.1
            Sh.Range("v2").Copy
            Sh.Range("v3:v" & Ends).PasteSpecial Paste:=xlPasteAll, Operation:=xlMultiply, _
                    SkipBlanks:=False, Transpose:=False
            Sh.Range("v2") = "1次"
            Wb.Save
        End If
        If Wbnm <> ThisWorkbook.Name Then Wb.Close
        Wbnm = Dir
    Next
Loop
Application.ScreenUpdating = True
Application.DisplayAlerts = True
Set Wb = Nothing
End Sub
大概这样的把其中一个改成。xlsm格式，运行它，若另起一个工作簿，自己改改吧！

qiaodong64

苏子龙 发表于 2017-1-9 18:20
Sub tt()
Dim Wb As Workbook, Sh As Worksheet, Wbnm As String
Dim Ends As Long, Mypath As String

没问题 多谢

望帝春心

1. Sub test()
   
2.     Dim pth As String, arr, i&, file As String, wb As Workbook
   
3.     Application.DisplayAlerts = False
   
4.     Application.ScreenUpdating = False
   
5.     pth = ThisWorkbook.Path & ""
   
6.     file = Dir(pth & "*.xls*")
   
7.     Do While file <> ""
   
8.         If file = ThisWorkbook.Name Then
   
9.             Set wb = ActiveWorkbook
   
10.         Else
    
11.             Set wb = Workbooks.Open(pth & file)
    
12.         End If
    
13.         With wb.Sheets(1)
    
14.             arr = .Range(.Cells(1, "v").End(4), .Cells(Rows.Count, "v").End(3))
    
15.             For i = 1 To UBound(arr)
    
16.                 arr(i, 1) = arr(i, 1) * 1.1
    
17.             Next
    
18.             .Cells(1, "v").End(4).Resize(UBound(arr), 1) = arr
    
19.         End With
    
20.         If file <> ThisWorkbook.Name Then wb.Close True
    
21.         file = Dir
    
22.     Loop
    
23.     Application.DisplayAlerts = True
    
24.     Application.ScreenUpdating = True
    
25.     Set wb = Nothing
    
26. End Sub

复制代码

水一发

qiaodong64

望帝春心 发表于 2017-1-9 19:23
水一发

多谢大神

望帝春心

qiaodong64 发表于 2017-1-9 19:57
多谢大神

瞎搞的，从来没写遍历的代码，这是第一回