精华内容
下载资源
问答
  • B8:S200是需要清空的区域) <code>Worksheets("sheet1").Range("B8:S200").Clear Worksheets("sheet1").Range("B8:S200").ClearContents</code></pre> <code>Dim rng As ...
  • Excel VBA 根据Sheet2中的表格数据处理Sheet1中的数据,包括:1,对sheet1和sheet2指定数据的循环比较;2,符合条件的数据复制至sheet1中,并且用表格颜色进行标记
  • Excel VBA自动填充公式

    2021-10-11 11:23:03
    通过vba函数实现:写入一个公式到单元格中,并自动填充该公式到该列指定范围中。

    通过vba函数实现:写入一个公式到单元格中,并自动填充该公式到该列指定范围中。

    ❤ 代码1(在当前文件中添加公式):

    Sub 在当前文件中自动填充一列公式(sheetName As String, cellStr As String, r As String, formulaStr As String)
    '
    'sheetName:sheet名
    'cellStr:要填充的起始单元格,如“A1”
    'r:要写入的范围,如“A1:A100”
    'formulaStr:公式字符串
    '
    
        '激活sheet
        ThisWorkbook.Sheets(sheetName).Activate
    
        '选中要填入公式的单元格
        ThisWorkbook.ActiveSheet.Range(cellStr).Select
    
        '写入公式
        Selection.Formula = formulaStr
    
        '选中该单元格
        ThisWorkbook.ActiveSheet.Range(cellStr).Select
    
        '自动填充
        Selection.AutoFill Destination:=ThisWorkbook.ActiveSheet.Range(r), Type:=xlFillDefault
        ThisWorkbook.ActiveSheet.Range(r).Select
        
        '保存
        ThisWorkbook.Save
        
    End Sub

    ❤ 代码2(在目标文件中添加公式):

    Sub 在目标文件中自动填充一列公式(srcPath As String, sheetName As String, cellStr As String, r As String, formulaStr As String)
    '
    'srcPath:文件路径
    'sheetName:sheet名
    'cellStr:要填充的起始单元格
    'r:要写入的范围
    'formulaStr:公式
    '
        '打开目标Excel文件
        Set srcWb = Workbooks.Open(srcPath)
        srcWb.Sheets(sheetName).Activate
        '选中单元格
        srcWb.ActiveSheet.Range(cellStr).Select
        '写入公式
        Selection.Formula = formulaStr
        srcWb.ActiveSheet.Range(cellStr).Select
        '自动填充到指定范围
        Selection.AutoFill Destination:=srcWb.ActiveSheet.Range(r), Type:=xlFillDefault
        srcWb.ActiveSheet.Range(r).Select
        
        '保存
        srcWb.Save
        '关闭
        srcWb.Close
    
    End Sub

    展开全文
  • 在Excel中【审阅】【保护工作表】可以选择对工作表进行保护,下面的代码可以用于对输入内容的单元格进行保护: Private Sub Worksheet_SelectionChange(ByVal Target As Range) On Error Resume Next '出错误之后向...

    在Excel中【审阅】【保护工作表】可以选择对工作表进行保护,下面的代码可以用于对输入内容的单元格进行保护:

    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        On Error Resume Next '出错误之后向下执行
    	Sheet1.Unprotect Password:="1234"  '设置密码
    	If Target.Value <> "" Then  '单元格编辑后,不为空
            Target.Locked = True
            Sheet1.Protect Password:="1234"
        End If
    End Sub
    
    展开全文
  • 通过员工培训和自我提升,掌握和使用excel数组公式和VBA自动化,能为员工节省巨大的时间和精力,提高工作附加值。同时作为公司效率化和系统化改善的一部分,为公司效益带来显著提升。以下通过一些案例,展示利用...

      在制造业公司的生产管理,经营管理,采购管理,财务管理等工作中,都有大量的数据处理的任务,通过繁复的excel手工运算获取结果。通过员工培训和自我提升,掌握和使用excel数组公式和VBA自动化,能为员工节省巨大的时间和精力,提高工作附加值。同时作为公司效率化和系统化改善的一部分,为公司效益带来显著提升。以下通过一些案例,展示利用excel公式和VBA进行自动化数据分析,数据汇总,网页表单自动提交在实际场景中的典型应用。相关的文件和代码可以在github下载。

    • 自动化数据分析

      以下是通过VBA自动化数据分析来计算预计在手和在途库存的流程。

     

     

      以下是预计在手和在途库存的代码。

     

      1 Sub 预计在手和在途()
      2 '
      3 ' 预计在手和在途 宏
      4 '
      5     SCH_IDITEM_NO (7)
      6     SCH_IDITEM_NO (11)
      7     SCH_IDITEM_NO (21)
      8     
      9     P = ActiveWorkbook.Path
     10     Columns("C:C").Select
     11     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
     12     Range("C1").Select
     13     ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
     14     Range("C1").Select
     15     Selection.AutoFill Destination:=Range("C1:C138750")
     16     Columns("C:C").Select
     17     Selection.Copy
     18     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     19         :=False, Transpose:=False
     20         
     21     For Each cel In Range("c2:c160000")
     22         If IsNumeric(cel) And cel <> "" Then
     23             cel.Value = Val(cel.Value)
     24         End If
     25     Next
     26     
     27     Range("A1").Select
     28     Range(Selection, Selection.End(xlDown)).Select
     29     Range(Selection, Selection.End(xlToRight)).Select
     30     Selection.Copy
     31     Workbooks.Open ("C:\Users\5106002125\Desktop\企划管理\静态参考资料\套用公式\在库试算.xlsx")
     32     Sheets.Add After:=Sheets(Sheets.Count)
     33     Range("A1").Select
     34     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     35         :=False, Transpose:=False
     36     Rows("1:1").Select
     37     Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
     38     
     39     Sheets("7").Select
     40     ActiveSheet.UsedRange.Select
     41     Selection.Clear
     42     Sheets("11").Select
     43     ActiveSheet.UsedRange.Select
     44     Selection.Clear
     45     Sheets("21").Select
     46     ActiveSheet.UsedRange.Select
     47     Selection.Clear
     48     
     49     Set book1 = Workbooks.Open("C:\Users\5106002125\Desktop\企划管理\过期\7.csv")
     50     Set book2 = Workbooks.Open("C:\Users\5106002125\Desktop\企划管理\过期\11.csv")
     51     Set book3 = Workbooks.Open("C:\Users\5106002125\Desktop\企划管理\过期\21.csv")
     52     
     53     Windows("7.csv").Activate
     54     Range("A1").Select
     55     Range(Selection, Selection.End(xlDown)).Select
     56     Range(Selection, Selection.End(xlToRight)).Select
     57     Selection.Copy
     58     Windows("在库试算.xlsx").Activate
     59     Sheets("7").Select
     60     Range("A1").Select
     61     ActiveSheet.Paste
     62     
     63     Windows("11.csv").Activate
     64     Range("A1").Select
     65     Range(Selection, Selection.End(xlDown)).Select
     66     Range(Selection, Selection.End(xlToRight)).Select
     67     Selection.Copy
     68     Windows("在库试算.xlsx").Activate
     69     Sheets("11").Select
     70     Range("A1").Select
     71     ActiveSheet.Paste
     72         
     73     Windows("21.csv").Activate
     74     Range("A1").Select
     75     Range(Selection, Selection.End(xlDown)).Select
     76     Range(Selection, Selection.End(xlToRight)).Select
     77     Selection.Copy
     78     Windows("在库试算.xlsx").Activate
     79     Sheets("21").Select
     80     Range("A1").Select
     81     ActiveSheet.Paste
     82     
     83     
     84     For col = 20 To 41
     85     
     86     Sheets("公式").Select
     87     Range(Cells(2, col), Cells(3, col)).Select
     88     Application.CutCopyMode = False
     89     Selection.Copy
     90     Sheets("Sheet2").Select
     91     Range(Cells(2, col), Cells(3, col)).Select
     92     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
     93         SkipBlanks:=False, Transpose:=False
     94     
     95     Range(Cells(3, col), Cells(3, col)).Select
     96     Application.CutCopyMode = False
     97     Selection.AutoFill Destination:=Range(Cells(3, col), Cells(200000, col))
     98 
     99     Range(Cells(3, col), Cells(200000, col)).Copy
    100     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    101         :=False, Transpose:=False
    102 
    103     Next
    104 
    105 
    106     Sheets("公式").Select
    107     Range(Cells(1, 1), Cells(1, 41)).Select
    108     Application.CutCopyMode = False
    109     Selection.Copy
    110     Sheets("Sheet2").Select
    111     Range(Cells(1, 1), Cells(1, 41)).Select
    112     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    113         SkipBlanks:=False, Transpose:=False
    114 
    115     Dim r As Integer
    116     Range("a2").Select
    117     Selection.End(xlDown).Select
    118     r = Selection.row
    119     Range(Cells(1, 1), Cells(r, 41)).Copy
    120     Workbooks.Add
    121     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, SkipBlanks _
    122         :=False, Transpose:=False
    123     Application.CutCopyMode = False
    124     Range("AC1:AO1").Style = "Comma"
    125 
    126     Range("AM2:AO2").Select
    127     Range("AO2").Activate
    128     Range(Selection, Selection.End(xlDown)).Select
    129     Sheets.Add
    130     ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    131         "Sheet1!R2C39:R138210C41", Version:=xlPivotTableVersion14).CreatePivotTable _
    132         TableDestination:="Sheet4!R3C1", TableName:="数据透视表1", DefaultVersion:= _
    133         xlPivotTableVersion14
    134     Sheets("Sheet4").Select
    135     Cells(3, 1).Select
    136     With ActiveSheet.PivotTables("数据透视表1").PivotFields("库位2")
    137         .Orientation = xlRowField
    138         .Position = 1
    139     End With
    140     ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
    141         ).PivotFields("在手"), "求和项:在手", xlSum
    142     ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
    143         ).PivotFields("在途"), "计数项:在途", xlCount
    144     With ActiveSheet.PivotTables("数据透视表1").PivotFields("计数项:在途")
    145         .Caption = "求和项:在途"
    146         .Function = xlSum
    147     End With
    148     Cells.Select
    149     Selection.Style = "Comma"
    150     
    151     ActiveWorkbook.SaveAs Filename:=P & "\在库试算结果" & ".xlsx", FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    152 
    153     book1.Close savechanges:=True
    154     book2.Close savechanges:=True
    155     book3.Close savechanges:=True
    156 
    157 End Sub
    158 Function SCH_IDITEM_NO(n)
    159 '
    160 ' SCH_IDITEM_NO 宏
    161 '
    162 
    163 '
    164     p1 = ActiveWorkbook.Path
    165     Workbooks.Open (p1 & "\" & n & ".csv")
    166     Columns("C:C").Select
    167     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    168     Range("C1").Select
    169     ActiveCell.FormulaR1C1 = "=RC[-2]&RC[-1]"
    170     Range("C1").Select
    171     Selection.AutoFill Destination:=Range("C1:C138750")
    172     Columns("C:C").Select
    173     Selection.Copy
    174     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    175         :=False, Transpose:=False
    176         
    177     For Each cel In Range("c2:c160000")
    178         If IsNumeric(cel) And cel <> "" Then
    179             cel.Value = Val(cel.Value)
    180         End If
    181     Next
    182         
    183     ActiveWorkbook.SaveAs Filename:="C:\Users\5106002125\Desktop\企划管理\过期\" & ActiveWorkbook.Name, FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    184     ActiveWorkbook.Close
    185 End Function

      

      以下是通过VBA自动化计算实际在库金额的代码,比预计在手和在途库存的流程简单。

     1 Sub 实际在库()
     2 '
     3 ' 实际在库 宏
     4 '
     5 
     6 '
     7     Range("A1").Select
     8     Range(Selection, Selection.End(xlDown)).Select
     9     Range(Selection, Selection.End(xlToRight)).Select
    10     Selection.Copy
    11     Workbooks.Open ("C:\Users\5106002125\Desktop\企划管理\静态参考资料\套用公式\201603库存 结果.xlsx")
    12     Sheets.Add After:=Sheets(Sheets.Count)
    13     Range("A1").Select
    14     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    15         :=False, Transpose:=False
    16     Sheets("3月底在库").Select
    17     Range("Q1:Q2").Select
    18     Application.CutCopyMode = False
    19     Selection.Copy
    20     Sheets("Sheet1").Select
    21     Range("O1").Select
    22     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    23         SkipBlanks:=False, Transpose:=False
    24     Range("O2").Select
    25     Sheets("3月底在库").Select
    26     Range("O1:Q2").Select
    27     Application.CutCopyMode = False
    28     Selection.Copy
    29     Sheets("Sheet1").Select
    30     Range("O1").Select
    31     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    32         SkipBlanks:=False, Transpose:=False
    33     Range("O2:P2").Select
    34     Application.CutCopyMode = False
    35     Selection.AutoFill Destination:=Range("O2:P18191")
    36     Range("a1").Select
    37     Range(Selection, Selection.End(xlDown)).Select
    38     Range(Selection, Selection.End(xlToRight)).Select
    39     Selection.Copy
    40     Workbooks.Add
    41     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    42         :=False, Transpose:=False
    43     Application.CutCopyMode = False
    44     Sheets.Add
    45     ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    46         "Sheet1!R1C1:R18191C17", Version:=xlPivotTableVersion14).CreatePivotTable _
    47         TableDestination:="Sheet4!R3C1", TableName:="数据透视表1", DefaultVersion:= _
    48         xlPivotTableVersion14
    49     Sheets("Sheet4").Select
    50     Cells(3, 1).Select
    51     ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
    52         ).PivotFields("END_AMT"), "求和项:END_AMT", xlSum
    53     With ActiveSheet.PivotTables("数据透视表1").PivotFields("机种")
    54         .Orientation = xlRowField
    55         .Position = 1
    56     End With
    57 
    58     Cells.Select
    59     Selection.Style = "Comma"
    60 End Sub

     

     

    • 自动化数据汇总

      以下是通过VBA自动化数据汇总来计算生产计划变化推移图的流程。

     

      

      以下是计算生产计划变化推移图的代码。

    第一次VBA计算
    1
    Sub Capa_MTG运算() 2 3 '对话框,确认已经打开Capa MTG 4 Dim Msg, Style, title, Help, Ctxt, Response, MyString 5 Msg = "当前窗口是Capa MTG?" ' 定义信息。 6 Style = vbYesNo + vbCritical + vbDefaultButton2 ' 定义按钮。 7 title = "打开Capa MTG" ' 定义标题。 8 Response = MsgBox(Msg, Style, title) 9 10 '提取最新的计划 11 12 If Response = vbYes Then ' 用户按下“是”。 13 For j = 1 To 6 '在第一到第六个工作表运行程序 14 Worksheets(j).Select '选定工作表 15 [a1:dd300].UnMerge '所有单元格取消合并 16 Rows("6:6").Select 17 Selection.AutoFilter '自动筛选 18 Range("C2:C124").Select 19 Selection.Copy 20 Range("F8:f130").Select 21 Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 22 :=False, Transpose:=False '复制最新计划的机种名,到计划台数的这一列 23 Next 24 End If 25 26 'OPT计划复制到BPJ 27 28 Sheets("opt").Range("C2:Dd150").Copy 29 Sheets("bpj").Range("c132").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _ 30 :=False, Transpose:=False 31 Sheets("bpj").Range("g127") = "0" 32 Sheets("bpj").Range("f65") = "LEOPARD" 33 For j = 1 To 6 '在第一到第六个工作表运行程序 34 Worksheets(j).Select '选定工作表 35 36 '自动筛选,获得最新计划原始数据 37 38 Dim i As Integer 39 For i = 8 To 63 40 If Range("f" & i) = 0 Then 41 Range("g" & i) = "0" 42 End If 43 Next 44 For i = 66 To 300 45 If Range("f" & i) = 0 Then 46 Range("g" & i) = "0" 47 End If 48 Next 49 Range("bb65:dc65") = "0" 50 ActiveSheet.Range("$A$6:$DD$300").AutoFilter Field:=7, Criteria1:="" 51 Next 52 53 '保存修改后的文件到本地 54 55 ActiveWorkbook.SaveAs Filename:= _ 56 "C:\Users\5106002125\Desktop\企划管理\过期\Capa MTG16.xlsx", FileFormat:= _ 57 xlOpenXMLWorkbook, CreateBackup:=False 58 End Sub

     

    第二次VBA计算
     1 Sub PSG生产计划变化()
     2 
     3     Application.ScreenUpdating = False
     4     
     5     Dim wkbname As Integer
     6 
     7 '在每个工作表运行程序
     8 
     9 For wkbname = 1 To 5
    10     Worksheets(wkbname).Select
    11     Pro_change (wkbname)
    12 Next
    13 
    14 End Sub
    15 Function Pro_change(wkbname As Integer)
    16 
    17 '指定复制的行数
    18 
    19     Dim row As Integer
    20     If wkbname = 1 Then
    21         row = 23
    22     ElseIf wkbname = 2 Then
    23         row = 4
    24     ElseIf wkbname = 3 Then
    25         row = 2
    26     Else: row = 1
    27     End If
    28     
    29 '复制前一周的计划数量
    30 
    31     Range("a3").Select
    32     Selection.End(xlDown).Offset(1 - row, 0).Resize(row, 250).Select
    33     Selection.Copy
    34     Selection.Offset(row, 0).Activate
    35     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    36         :=False, Transpose:=False
    37         
    38 'WK赋值
    39 
    40     Dim wk As Integer
    41     wk = Application.WeekNum(Now() - 11)
    42     Range("b3").Select
    43     Selection.End(xlDown).Offset(1 - row, -1).Resize(row, 1).Value = wk
    44 
    45 '复制最新生产计划
    46 
    47     Range("c1").Select
    48     Selection.Copy
    49     Selection.End(xlDown).Offset(1 - row, 20).Resize(row, 200).Select
    50     ActiveSheet.Paste
    51     Application.CutCopyMode = False
    52     
    53 '复制前一周的计划格式
    54 
    55     Range("a3").Select
    56     Selection.End(xlDown).Offset(1 - row * 2, 0).Resize(row, 250).Select
    57     Selection.Copy
    58     Selection.Offset(row, 0).Activate
    59     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    60         :=False, Transpose:=False
    61         
    62 '更新最新计划的单元格格式
    63         
    64     Range("a3").Select
    65     Selection.End(xlDown).Offset(1 - row, wk - 1).Resize(row, 2).Select
    66     Selection.Copy
    67     Selection.Offset(0, 2).Activate
    68     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, SkipBlanks _
    69         :=False, Transpose:=False
    70         
    71 '保存新的生产计划区域为数值
    72         
    73     Range("c1").Select
    74     Selection.End(xlDown).Offset(1 - row, 20).Resize(row, 250).Select
    75     Selection.Copy
    76     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    77         :=False, Transpose:=False
    78     
    79 End Function

     

     

     

    • 自动提交网页表单

      以下是通过VBA自动提交网页表单来提交未着发票信息的流程。

     

     

      以下是自动化提交未着发票信息的工作表界面,其中左边三列由公式自动生成结果。

     

      以下是自动化提交未着发票信息的代码。

     1 Sub 手动未着()
     2 
     3 '共有多少张发票
     4 Dim InvoLength As Integer
     5 InvoLength = Cells(5, 4).Value  '列表共几张发票
     6 
     7 Dim ie As Object
     8 Set ie = CreateObject("InternetExplorer.application")
     9     With ie
    10         For i = 1 To InvoLength
    11             Cells(5, 1) = i         '第几张发票
    12             j = Cells(5, 2)         '这张发票在第几列开始
    13             manual_invo j, ie       '打开网页填写信息
    14         Next
    15     End With
    16 
    17 'Err_Handle:
    18 '        MsgBox ("请重新填写信息后提交")
    19 End Sub
    20 Function manual_invo(j, ie)
    21     Dim row_base, ItemLength_ttl As Integer
    22     Dim SLIP_NO, VENDOR_CD, Amt As String
    23     row_base = 8                        '数据开始的列数 - 1
    24     ItemLength_ttl = Cells(5, 3)        '当前发票共有多少订单
    25     SLIP_NO = Cells(j + row_base, 4)    '发票号
    26     VENDOR_CD = Cells(j + row_base, 5)  '供应商
    27     
    28     With ie
    29         .navigate "https://ssv21.imapsv2.sony.co.jp/iak100/main/Invg0500?ActionType=GoFirst"
    30         .Visible = True
    31         Do Until .readyState = 4
    32         Loop
    33         
    34         '填写发票和供应商,点击搜索,等待页面加载
    35         .document.getElementById("VENDOR_CD:Upper").Value = VENDOR_CD
    36         .document.getElementById("SLIP_NO:Upper").Value = SLIP_NO
    37         .document.getElementById("SERACH_BTN").Click
    38         Do Until .readyState = 4 And .Busy = False
    39             DoEvents
    40         Loop
    41         
    42         '发票BL时间,货币,保课税,点击“GO”,等待页面加载
    43         .document.getElementById("SLIP_DATE:Date").Value = Cells(j + row_base, 6)
    44         .document.getElementById("SLIP_CUR:Upper").Value = Cells(j + row_base, 7)
    45         .document.getElementById("TRADE_TYPE_LIST").Value = Cells(j + row_base, 8)
    46         .document.getElementById("GO_BTN").Click
    47         Do Until .readyState = 4 And .Busy = False
    48             DoEvents
    49         Loop
    50         
    51         '录入发票中每一条订单
    52         For k = 1 To ItemLength_ttl
    53             fill_invo_item k, j, row_base, ie
    54         Next
    55         
    56         '录入AMT
    57         .document.getElementById("INVOICE_AMT").Value = Cells(j + row_base, 11)
    58         
    59         '最后点击执行按钮
    60         .document.getElementById("BTN_EXECUTE").Click
    61         Do Until .readyState = 4 And .Busy = False
    62             DoEvents
    63         Loop
    64         
    65         '等待1秒
    66         Application.Wait (Now + TimeValue("0:00:01"))
    67         
    68     End With
    69 End Function
    70 Function fill_invo_item(k, j, row_base, ie)
    71     With ie
    72     
    73         '点击ADD_PO,等待页面加载
    74         .document.getElementById("BTN_ADDPO").Click
    75         Do Until .readyState = 4 And .Busy = False
    76             DoEvents
    77         Loop
    78         
    79         '填写PO,点击“GO”,等待页面加载
    80         .document.getElementById("ORDER_NO:Upper").Value = Cells(j + row_base, 9).Offset(k - 1, 0)
    81         .document.getElementById("GO_BTN").Click
    82         Do Until .readyState = 4 And .Busy = False
    83             DoEvents
    84         Loop
    85         
    86         '不填写其他信息再次点击“GO”,等待页面加载
    87         '.document.getElementById("INVG0500_LIST(" & k - 1 & "/INVOICE_QTY_NEW").Value = Cells(j + row_base, 10).Offset(k - 1, 0)
    88         '.document.getElementById("INVG0500_LIST(" & k - 1 & "/UNIT_PRICE").Value = Cells(j + row_base, 13).Offset(k - 1, 0)
    89         .document.getElementById("GO_BTN").Click
    90         Do Until .readyState = 4 And .Busy = False
    91             DoEvents
    92         Loop
    93         
    94         '填写后在EXCEL这一列打勾
    95         Cells(j + row_base, 12).Offset(k - 1, 0).Value = ""
    96         
    97     End With
    98 End Function

     

     

    • VBA自动化创建调查表

      以下是自动化创建PUSH OUT调查表的代码。  

      1 Sub 创建PUSH_OUT_LIST()
      2 '
      3 ' 创建PUSH_OUT_LIST 宏
      4     a = Val(InputBox("输入1是每月,输入2是季度", "选项", 1))
      5     If a = 1 Then
      6         b = "每月"
      7     ElseIf a = 2 Then
      8         b = "季度"
      9     End If
     10     ActiveWorkbook.SaveAs Filename:= _
     11         "C:\Users\5106002125\Desktop\PUSH_OUT原始数据" & Format(Date, "yyyymmdd") & Second(Now) & ".xlsx", FileFormat:= _
     12         xlOpenXMLWorkbook, CreateBackup:=False
     13     Range("A1").Select
     14     Range(Selection, Selection.End(xlDown)).Select
     15     Range(Selection, Selection.End(xlToRight)).Select
     16     Selection.Copy
     17     Workbooks.Open ("C:\Users\5106002125\Desktop\企划管理\静态参考资料\套用公式\PUSH OUT 算法 " & b & "推进.xlsx")
     18     Sheets.Add After:=Sheets(Sheets.Count)
     19     Range("A1").Select
     20     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     21         :=False, Transpose:=False
     22     Sheets("公式").Select
     23     Range("N1:Y2").Select
     24     Application.CutCopyMode = False
     25     Selection.Copy
     26     Sheets("Sheet1").Select
     27     Range("N1").Select
     28     Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
     29     SkipBlanks:=False, Transpose:=False
     30     Range("N2:Y2").Select
     31     Application.CutCopyMode = False
     32     Selection.AutoFill Destination:=Range("N2:Y181910")
     33     
     34     Range("a1").Select
     35     Range(Selection, Selection.End(xlDown)).Select
     36     Range(Selection, Selection.End(xlToRight)).Select
     37     Selection.Copy
     38     Workbooks.Add
     39     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     40         :=False, Transpose:=False
     41     Application.CutCopyMode = False
     42     
     43 
     44     
     45     Columns("h:h").Select
     46     Selection.Cut
     47     Columns("u:u").Select
     48     Selection.Insert Shift:=xlToRight
     49     
     50     Columns("v:v").Select
     51     Selection.Cut
     52     Columns("e:e").Select
     53     Selection.Insert Shift:=xlToRight
     54     
     55     Columns("w:w").Select
     56     Selection.Cut
     57     Columns("c:c").Select
     58     Selection.Insert Shift:=xlToRight
     59     
     60     [Z1] = "PUSH OUT结果"
     61     [AA1] = "COMMENT"
     62     
     63     Columns("Y:Y").Select
     64     Selection.Delete Shift:=xlToLeft
     65     ActiveWorkbook.SaveAs Filename:= _
     66         "C:\Users\5106002125\Desktop\PUSH_OUT" & Format(Date, "yyyymmdd") & Second(Now) & ".xlsx", FileFormat:= _
     67         xlOpenXMLWorkbook, CreateBackup:=False
     68     
     69     Windows("PUSH OUT 算法 " & b & "推进.xlsx").Activate
     70     Sheets("Sheet1").Select
     71     ActiveWindow.SelectedSheets.Delete
     72     
     73     Set sh1 = Workbooks("PUSH OUT 算法 " & b & "推进")
     74     sh1.Close
     75 
     76     Columns("U:U").Select
     77     Selection.Delete Shift:=xlToLeft
     78     Columns("O:S").Select
     79     Range("S1").Activate
     80     Selection.Delete Shift:=xlToLeft
     81     Range("A1:T1").Select
     82     Range("T1").Activate
     83     With Selection.Interior
     84         .Pattern = xlSolid
     85         .PatternColorIndex = xlAutomatic
     86         .ThemeColor = xlThemeColorAccent6
     87         .TintAndShade = 0.399975585192419
     88         .PatternTintAndShade = 0
     89     End With
     90 
     91     Range("A2").Select
     92     Range(Selection, Selection.End(xlDown)).Select
     93     Range(Selection, Selection.End(xlToRight)).Select
     94     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
     95     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
     96     With Selection.Borders(xlEdgeLeft)
     97         .LineStyle = xlContinuous
     98         .ColorIndex = xlAutomatic
     99         .TintAndShade = 0
    100         .Weight = xlHairline
    101     End With
    102     With Selection.Borders(xlEdgeTop)
    103         .LineStyle = xlContinuous
    104         .ColorIndex = xlAutomatic
    105         .TintAndShade = 0
    106         .Weight = xlHairline
    107     End With
    108     With Selection.Borders(xlEdgeBottom)
    109         .LineStyle = xlContinuous
    110         .ColorIndex = xlAutomatic
    111         .TintAndShade = 0
    112         .Weight = xlHairline
    113     End With
    114     With Selection.Borders(xlEdgeRight)
    115         .LineStyle = xlContinuous
    116         .ColorIndex = xlAutomatic
    117         .TintAndShade = 0
    118         .Weight = xlHairline
    119     End With
    120     With Selection.Borders(xlInsideVertical)
    121         .LineStyle = xlContinuous
    122         .ColorIndex = xlAutomatic
    123         .TintAndShade = 0
    124         .Weight = xlHairline
    125     End With
    126     With Selection.Borders(xlInsideHorizontal)
    127         .LineStyle = xlContinuous
    128         .ColorIndex = xlAutomatic
    129         .TintAndShade = 0
    130         .Weight = xlHairline
    131     End With
    132     Columns("S:T").Select
    133     Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    134     Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    135     With Selection.Borders(xlEdgeLeft)
    136         .LineStyle = xlContinuous
    137         .ColorIndex = 0
    138         .TintAndShade = 0
    139         .Weight = xlMedium
    140     End With
    141     With Selection.Borders(xlEdgeTop)
    142         .LineStyle = xlContinuous
    143         .ColorIndex = 0
    144         .TintAndShade = 0
    145         .Weight = xlMedium
    146     End With
    147     With Selection.Borders(xlEdgeBottom)
    148         .LineStyle = xlContinuous
    149         .ColorIndex = 0
    150         .TintAndShade = 0
    151         .Weight = xlMedium
    152     End With
    153     With Selection.Borders(xlEdgeRight)
    154         .LineStyle = xlContinuous
    155         .ColorIndex = 0
    156         .TintAndShade = 0
    157         .Weight = xlMedium
    158     End With
    159     Selection.Borders(xlInsideVertical).LineStyle = xlNone
    160     Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    161     Rows("2:2").Select
    162     Range("D2").Activate
    163     With ActiveWindow
    164         .SplitColumn = 0
    165         .SplitRow = 1
    166     End With
    167     ActiveWindow.FreezePanes = True
    168     Rows("1:1").Select
    169     Range("D1").Activate
    170     Selection.AutoFilter
    171     ActiveSheet.Range("$A$1:$Z$26903").AutoFilter Field:=15, Criteria1:="=0", _
    172         Operator:=xlOr, Criteria2:="=#N/A"
    173     Rows("2:2").Select
    174     Range(Selection, Selection.End(xlDown)).Select
    175     Selection.Delete Shift:=xlUp
    176     Selection.AutoFilter
    177     Rows("1:1").Select
    178     Selection.AutoFilter
    179     Columns("D:E").EntireColumn.AutoFit
    180     Columns("U:AL").Select
    181     Selection.Delete Shift:=xlToLeft
    182     Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    183     Range("O1").FormulaR1C1 = "=SUBTOTAL(9,R[2]C:R[2999]C)"
    184     Range("O1").Select
    185     Selection.Style = "Comma"
    186     Range("S1:t1") = "担当答复"
    187     Range("u1:v1") = "企划填写"
    188     Range("Q2").Copy
    189     Range("U2:v2").Select
    190     Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
    191         SkipBlanks:=False, Transpose:=False
    192     Application.CutCopyMode = False
    193     Range("U2") = "依赖日期"
    194     Range("V2") = "备注(新增/变更)"
    195     Range("O1,S1,T1,V1,U1").Select
    196     Range("U1").Activate
    197     With Selection.Interior
    198         .Pattern = xlSolid
    199         .PatternColorIndex = xlAutomatic
    200         .Color = 49407
    201         .TintAndShade = 0
    202         .PatternTintAndShade = 0
    203     End With
    204     With Selection.Font
    205         .ThemeColor = xlThemeColorDark1
    206         .TintAndShade = 0
    207     End With
    208     Columns("K:K").Select
    209     Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    210     Range("K2") = "NEW_DUE_DATE(上周)"
    211     Range("L2") = "NEW_DUE_DATE(本周)"
    212     Sheets("Sheet2").Select
    213     ActiveWindow.SelectedSheets.Delete
    214     Sheets("Sheet3").Select
    215     ActiveWindow.SelectedSheets.Delete
    216     Sheets.Add
    217     
    218    ActiveWorkbook.PivotCaches.Create(SourceType:=xlDatabase, SourceData:= _
    219         "Sheet1!R2C10:R1048576C19", Version:=xlPivotTableVersion14).CreatePivotTable _
    220         TableDestination:="Sheet4!R3C1", TableName:="数据透视表1", DefaultVersion:= _
    221         xlPivotTableVersion14
    222     Sheets("Sheet4").Select
    223     Cells(3, 1).Select
    224     ActiveSheet.PivotTables("数据透视表1").AddDataField ActiveSheet.PivotTables("数据透视表1" _
    225         ).PivotFields("AMT"), "计数项:AMT", xlCount
    226     With ActiveSheet.PivotTables("数据透视表1").PivotFields("LOCATION")
    227         .Orientation = xlRowField
    228         .Position = 1
    229     End With
    230     With ActiveSheet.PivotTables("数据透视表1").PivotFields("ALRAM")
    231         .Orientation = xlColumnField
    232         .Position = 1
    233     End With
    234     With ActiveSheet.PivotTables("数据透视表1").PivotFields("计数项:AMT")
    235         .Caption = "求和项:AMT"
    236         .Function = xlSum
    237     End With
    238     Cells.Select
    239     Selection.Style = "Comma"
    240     Cells.EntireColumn.AutoFit
    241 
    242 End Sub

     

    • 其他
     1 Sub 调查汇总()
     2 
     3     'Application.ScreenUpdating = False
     4     Dim book1 As Workbook
     5     Dim book2 As Workbook
     6     path1 = ActiveWorkbook.Path
     7     Set book1 = ActiveWorkbook
     8     Workbooks.Add
     9     Set book2 = ActiveWorkbook
    10     book1.Activate
    11     For wkbname = 1 To Worksheets.Count
    12         Worksheets(wkbname).Select
    13         copy_visible book1, book2
    14     Next
    15     book2.SaveAs Filename:=path1 & "\调查结果汇总" & Format(Date, "yyyymmdd") & Second(Now()) & ".xlsx", _
    16         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    17 End Sub
    18 
    19 Function copy_visible(book1, book2)
    20     Range("A2").Select
    21     Range(Selection, Selection.End(xlDown)).Select
    22     Range(Selection, Selection.End(xlToRight)).Select
    23     Selection.Copy
    24     book2.Activate
    25     Range("A500000").Select
    26     Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
    27     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    28         :=False, Transpose:=False
    29     Application.CutCopyMode = False
    30     book1.Activate
    31 End Function

     

     1 Sub Sheet到Book()
     2 '
     3 ' Sheet到Book
     4 '
     5 path1 = ActiveWorkbook.Path
     6 book1 = ActiveWorkbook.Name
     7 ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible).Copy
     8 Workbooks.Add
     9 ActiveSheet.Paste
    10 ActiveWorkbook.SaveAs Filename:=path1 & "\" & Left(book1, Len(book1) - 5) & Format(Date, "yyyymmdd") & Second(Now()) & ".xlsx", _
    11         FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False
    12 '
    13 End Sub

     

     1 Sub 清理工作表()
     2 '
     3 ' 清理工作表 宏
     4 '
     5 
     6 '
     7     Rows("1:1").Select
     8     Range(Selection, Selection.End(xlDown)).Select
     9     Range(Selection, Selection.End(xlToRight)).Select
    10     Selection.Copy
    11     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    12         :=False, Transpose:=False
    13     ActiveWindow.LargeScroll ToRight:=-1
    14     Rows("1:1").Select
    15     Selection.End(xlDown).Offset(1, 0).Select
    16     Range(Selection, Selection.End(xlToRight)).Select
    17     Range(Selection, Selection.End(xlDown)).Select
    18     Selection.Delete Shift:=xlUp
    19     Rows("1:1").Select
    20     Selection.End(xlToRight).Offset(0, 1).Select
    21     Range(Selection, Selection.End(xlToRight)).Select
    22     Range(Selection, Selection.End(xlDown)).Select
    23     Selection.Delete Shift:=xlToLeft
    24 
    25 End Sub

     

     1 Sub 删除重复()
     2 '
     3 ' 宏3 宏
     4 '
     5 '
     6     Application.CutCopyMode = False
     7     Selection.Copy
     8     Sheets.Add After:=Sheets(Sheets.Count)
     9     Columns("A:A").Select
    10     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    11         :=False, Transpose:=False
    12     Application.CutCopyMode = False
    13     ActiveSheet.Range("$A$1:$A$100000").RemoveDuplicates Columns:=1, Header:=xlNo
    14 End Sub

     

    转载于:https://www.cnblogs.com/newer027/p/6418841.html

    展开全文
  • 我们在日常工作中经常会碰到excel自带公式无法解决的问题,在面对大量数据需要整理计算的时候会消耗大量的时间,如果你了解vba的一些技巧,就可以减少很多工作量。本篇文章将会带你进入一个简单、易懂的自动化世界。...

    excel数据整理

    我们在日常工作中经常会碰到excel自带公式无法解决的问题,在面对大量数据需要整理计算的时候会消耗大量的时间,如果你了解vba的一些技巧,就可以减少很多工作量。本篇文章将会带你进入一个简单、易懂的自动化世界。
    如果在工作中,你遇到了几列数据需要转置,如这样的数据:数据为假设数据
    需要转换成下图:
    在这里插入图片描述
    常规的方法可以进行选择12个月的数据进行选择性粘贴,如果数据量大的话,这可是一个十分耗费时间的过程。有了vba,我们就可以事半功倍的解决这一系列问题。
    在excel界面中安alt+f11即可打开vba编程界面,然后在左侧的目录框中右键点击创建模块,即可出现一下界面。
    在这里插入图片描述
    在里面插入以下代码即可完成上述工作。

    Sub excel数据整理()
    
    start_row = 2
    start_col = 3
    end_col = 5
    counts = 40
        For i = 0 To counts
            Range(Cells(start_row + 12 * i, start_col), Cells(start_row+12 + 12 * i, start_col)).Select
            Selection.Copy
            Cells(i + 2, end_col).Select
            Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, Transpose:=True
        Next i
        
    End Sub
    

    定义过程

    sub+过程名称+()为vba过程的开始,end sub为过程的结束。每个过程在编写之前都需要先把开始和结束语句写完。

    写入变量

    start_row为开始行号,start_col为开始列号,end_col为结束列号,counts 为循环次数。

    for循环设定

    for和next构成了循环语句,简单来说就是这个粘贴的过程需要进行多少次,i = 0 to counts就定义了该过程需要进行counts+1次。

    利用range和cells进行范围选择

    range为范围函数,里面的cells为单元格定位函数。range可以用两个cells函数来定义范围,开始为起始单元格,第二个为终止单元格。而cells函数则需要行号和列号两个参数来定义单元格位置。两个函数加在一起就可以定义一个范围,上述定义的范围为第3列的2行到13行这一个矩形区域。后面跟的12*i为循环变量。在i=0的时候定义范围为第3列的2行到13行,在等于1的时候定义范围变为第3列的14行到25行依次类推,直到i=counts时停止。

    excel自带函数进行转置粘贴

    Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, Transpose:=True为excel自带的选择性粘贴函数,我们需要转置,所以把Transpose:参数改为True。

    总结

    整体的过程可以概括为先利用range函数选中特定位置 Range(Cells(start_row + 12 * i, start_col), Cells(start_row+12 + 12 * i, start_col)),再利用 Selection.Copy进行复制,然后通过Cells(i + 2, end_col).Select选择要粘贴的位置,最后利用 Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _False, Transpose:=True进行转置操作。
    如果想进行改动以适应更广泛的情况,可以进行如下更改。
    1.counts值随动,改变后可进行循环次数的改变
    2.单元格中12可以改动,改动后可以选择更广阔的范围
    3.end_col可以改动,改动后可以改变结果的位置
    4.选择位置的操作可以进行省略,可以直接把复制单元格赋值给数组

    笔者也是vba的初学者,编程大佬可以略过这篇文章啦,希望对从没有这方面经验的小白有所帮助。

    展开全文
  • VBA实现 Excel自动填充

    千次阅读 2020-05-11 11:07:25
    简单的VBA代码搞定: Sub 自动填充() Dim i As Integer For i = 2 To 743 If Range("b" & i) = "" Then '此时只循环判断,填充了B列,只需手动更改一下代码中的"b".(下一段代码也要改) Range("b" & i) = ...
  • ​EXCEL是由很多的对象组成,每个对象都他的属性和方法,所谓的对象可以理解为所有存在的东西,在同一个程序里的对象之间是存在关系的,比如说上下级关系或同级关系,上下级关系之间用英文句点“.”连接。...
  • 或者从工作表的一个单元格区域复制到同一工作表中另外的单元格区域,或者从工作表的一个单元格区域复制到另一工作表中的单元格区域,甚至从工作表的一个单元格区域复制到不同工作簿中的工作表单元格区域。...
  • vba 编写的实现图表自动更新程序,在已经处理好的图表的模块上,进行图表数据源更新,从而实现图表自动更新,减少手工操作。
  • 1、底稿数据统一放一个文件夹里,把本模板放在该文件夹外面,在D3单元格填入文件夹名称2、在D4单元格填入要汇总的文件清单在本表的范围3、在D5单元格填入要自动copy过来的sheet名称4、选择数据粘贴方式汇总数据说明...
  • 我有一个很大的代码,它接受用户选择的参考号,并通过过滤和复制数据在多个其他工作表上定位相应的行(可以多个行,也可以没有行)。这很好,除了它复制所有可见数据(列A-N)当我真的希望它复制列A到K时(因为粘贴表上的L...
  • VBA 数据透视表的创建

    千次阅读 2021-01-21 15:21:37
    方法 读/写 值类别 默认值 说明 .ColumnGrand ...数据透视表在刷新或移动域时自动设置格式 ...如果数据透视表在错误的单元格中显示用户自定义的错误字符串,则该值为 True。 .ErrorString 返回...
  • 实现功能是,传递一个Range区域数据自动生成JSON字符串,行首为列名。 函数如下: Function GetJSON(myrange) Dim returnStr As String Dim count As Integer Dim colunms As Integer
  • 0) & "range sum" & d End Sub 获取筛选后数据行号 Sub find_filter_row_number() Dim cell As Range Dim i As Integer i = Range("a65535").End(xlUp).Row For Each cell In Range("a3:a" & i) If Rows(cell.Row)....
  • 网上看到的一个例子,需要将以下表格根据内容将近7天的数据自动发送给不同的客户。原始数据如下: 需要将生的最近n天明细表格如下 大概思路如下:获取邮箱->处理数据->生成EXCEL->生成Email在实际处理中,...
  • 蓝字关注,加微信NZ9668获资料信息VBA解决方案 系列丛书作者头条百家平台 VBA资深创作者_______________________________大家好,今日继续和大家分享VBA编程中常用的常用“积木”过程代码。这些内容大多是我的经验的...
  • 多个工作簿的sheet均在相同的位置有数据,如图所示 打开给定工作簿,选择按钮,输入你需要在多个表格中复制的数据位置(可以为空),但是切记,第一行和第一列不能为空和最短的数据,否则会被覆盖掉,因为是...
  • 本文介绍了利用 Excel 中的 Power Query 与 VBA 实现 CSV 格式数据清洗的关键步骤及思路,对实操过程中的性能提升等具体问题给出了解决办法,最后对此类问题给出了通用的注意事项,具备一定的指导性。
  • Private Sub Worksheet_Activate() Dim A As Range, RN As Range, RNS As Range, i As Integer For Each A In [c6:c9,c12:c50] If A = "" And A.Height <> 0 Then k = k + 1 If k = 1 Then
  • excel vba 数据分析

    千次阅读 2019-01-20 12:20:00
    VBA(Visual Basic for Application)是Microsoft Office系列软件的内置编程语言,其语法结构与Visual Basic编程语言互相兼容,采用的是面向对象的编程机制和可视化的编程环境。 第一节 标识符 一.定义 标识符是一...
  • 自动生成VBA窗体菜单

    2010-08-16 15:23:46
    自动生成VBA窗体菜单 '*************************** '* 菜单类 * '*************************** Option Explicit Private WithEvents MenuBar_MenuItem As MSForms.Label '菜单项 Private WithEvents WorkForm As...
  • 工作中,需要多次用到“自定义自动筛选方式”对话框,所以想到通过编写宏代码,以提高工作效率。在Excel Home上([如何用宏自定义自动筛选方式的快捷键](http://club.excelhome.net/thread-1117437-1-1.html ""))找到...
  • Hello,大家好,今天跟大家分享我们如何实现实现点击一个单元格,自动数据区域的整行填充一个颜色,效果如下图,当我们点击一个单元格的时候们就会为整行填充一个颜色,这个的操作跟我们之前分享的聚光灯效果十分...
  • VBA 的跨表数据更新

    千次阅读 2019-05-17 09:23:18
    VBA 的跨表数据更新 本次跨表更新,是将其中一个表格中的sheet页对应数据复制粘贴到,另一个表格的对应sheet页中。 '首先是将源文件打开,然后获取源文件对应sheet的,这里将目标文件的数据复制到源文件对应sheet ...
  • VBA案例7:自动生成透视表

    千次阅读 2017-11-15 00:00:00
    自动生成透视表程序案例:文本型:Private Sub CommandButton2_Click()Sheet5.Cells.ClearDim WS As WorksheetDim NewWS As WorksheetDim SourceRange As RangeDim NewRange As RangeDim PTC As PivotCacheDim PVT ...
  • 8 excel vba 往多行写入数据

    千次阅读 2018-02-06 15:31:47
    我们都知道, 一个表格里很多个单元格. 由前面可知,我们要往一个单元格里写入数据,首先就要获得这个单元格的引用. 这样程序才知道在哪里写入数据.  比如我们要往单元格 A1 写入数据, 可以用 range("A1") ,来表示...
  • 现在的日常工作中,大家都会遇到要在网页表单输入或者录入一些数据的情况,而这时可以用“阿冲全能点击王”软件来实现批量自动录入,代替我们手工做这些重复劳累的工作。阿冲全能点击王软件是一款完全图形化界面的...
  • 基于VBA数据录入界面开发

    千次阅读 2020-09-03 14:25:27
    基于VBA数据录入界面开发: 一、用户需求: EXCEL表格中需要录入信息过多,人为查找耗时且易出错。 二、功能实现: 根据输入信息,在界面查找并显示相应数据。 在界面填写待填充信息,同步保存到EXCEL表格。...

空空如也

空空如也

1 2 3 4 5 ... 20
收藏数 3,435
精华内容 1,374
关键字:

vba自动选择有数据的区域