这个遍历文件夹 代码是我搜的。 放在我这个代码里用不起来

wdh540119878

yoonger 发表于 2022-11-22 09:13
快速浏览了一下你的代码，好多好多错误，无从下手

大佬  您说

于箱长

wdh540119878 发表于 2022-11-22 10:45
咋跟你看的不太一样呢。。，您看一下，我又重新上传了附件

今天心好累，不想干活儿了

wdh540119878

于箱长 发表于 2022-11-22 14:19
今天心好累，不想干活儿了

我又换了一个遍历VBA  可以用了，但是表格修改完以后 文件变大。本来只有20K以内，VBA完后成1.4M，而且所有的都是1.4M。但内容其实很少

Sub bat()

Dim fso As New FileSystemObject
'因为定义了FileSystemObject，所以要先在vb窗口中，选择工具-引用-勾选Microsoft Scripting Runtime
'不然会报错

Dim objFile, objFolder
Dim pathw
Dim wb

pathw = "D:\政府采购办30年\2004\" '注意结尾处有"\"

Set objFolder = fso.GetFolder(pathw)

For Each objFile In objFolder.Files '用一个for循环不断读取文件夹里面的文件

If InStr(objFile.Name, "批量操作excel文件") = 0 Then '判断当前读取的是否本身这个在运行的文件，如果是则跳过

Set wb = Workbooks.Open(objFile.Path) '打开文件


  Rows("2:2").Select '第二行上方插入2行
    With Rows("2:3")
        .Insert Shift:=xlShiftDown
        .Select

ActiveSheet.Columns("F").Insert  '插入列
ActiveSheet.Columns("C").Insert
   
    Range("A2:B2 ").MergeCells = True                                          '合并A2-B2
    Range("A3:B3 ").MergeCells = True                                          '合并A3-B3
    Range("D2:G2 ").MergeCells = True                                          '合并D2-G2
    Range("D3:G3 ").MergeCells = True                                          '合并D3-G3
    Range("H2:I2 ").MergeCells = True                                          '合并D2-G2
    Range("H3:I3 ").MergeCells = True                                          '合并D3-G3
   
    Range("A1:I1").Select
    ActiveCell.FormulaR1C1 = "目录"                                   'A2单元格内容
   
    Range("A2:B2").Select
    ActiveCell.FormulaR1C1 = "类别"                                   'A2单元格内容
   
    Range("C2").Select                                          'C2单元格内容
    ActiveCell.FormulaR1C1 = "卷号"
   
    Range("D2:G2").Select
    ActiveCell.FormulaR1C1 = "案卷题名"                                   'A2单元格内容
   
    Range("H2:I2").Select
    ActiveCell.FormulaR1C1 = "保管期限"                                   'A2单元格内容
   
    Range("A3:B3").Select
    ActiveCell.FormulaR1C1 = "2004"                                   'A2单元格内容
   
    Range("H3:I3").Select
    ActiveCell.FormulaR1C1 = "30年"                                   'A2单元格内容
   
   
   
    Range("A4").Select
    ActiveCell.FormulaR1C1 = "序号"
   
    Range("B4:C4").Select
    ActiveCell.FormulaR1C1 = "责任者"
   
    Range("D4").Select
    ActiveCell.FormulaR1C1 = "文件号"
   
    Range("E4").Select
    ActiveCell.FormulaR1C1 = "文件题名"
   
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "文件日期"
   
    Range("G4").Select
    ActiveCell.FormulaR1C1 = "何种文字"
   
    Range("H4").Select
    ActiveCell.FormulaR1C1 = "所在页码"
   
    Range("I4").Select
    ActiveCell.FormulaR1C1 = "备注"
   
    Rows("1:65535").Select           '所有单元格改文本格式
Selection.NumberFormatLocal = "@"

Range([A2], [I4]).Borders.Weight = 2   'A2-I4加边框，1为虚线，0为无边框

   
Rows("1:1").Select              '1行字体字号
    With Selection.Font
        .Name = "宋体"
        .Size = 20
     End With
     
Rows("2:4").Select               '3行字体字号
    With Selection.Font
        .Name = "宋体"
        .Size = 11
    End With
        
   myendrow = Cells(6500, 1).End(xlUp).Row    '4-1200行字体字号
    Rows("5:" & 1200).Select
    With Selection.Font
        .Name = "宋体"
        .Size = 10
    End With

  .Columns("A:A").ColumnWidth = 3        '列宽Columns('A:A' ). ColumnWidth = 15
  .Columns("B:B").ColumnWidth = 5
  .Columns("C:C").ColumnWidth = 5
  .Columns("D:D").ColumnWidth = 8.5
  .Columns("E:E").ColumnWidth = 31.5
  .Columns("F:F").ColumnWidth = 9
  .Columns("G:G").ColumnWidth = 5
  .Columns("H:H").ColumnWidth = 4.5
  .Columns("I:I").ColumnWidth = 3.5
  
Rows("1:1").RowHeight = 25.5     '行高Rows(' 1:5' ). RowHeight = 15
Rows("2:2").RowHeight = 35.1
Rows("3:3").RowHeight = 65.1
Rows("4:4").RowHeight = 45.95
   
    Range("B4:C4 ").MergeCells = True                                          '合并B5-C5
    Range("B5:C5 ").MergeCells = True                                          '合并B5-C5
   
    If Range("A65536").End(xlUp).Row > 6 Then                        '复制5-6
Rows("5:5").Copy
Rows("6:" & Range("A65536").End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteFormats       '选择剩余有内容的粘贴格式

Application.CutCopyMode = False


ActiveWorkbook.Save '保存

ActiveWorkbook.Close '关闭

End If
    End With
    End If
    Next
End Sub

3190496160

不要谈你的代码，因为，只看你的代码是没法完全清楚你的需求的，
具体描述你的需求，模拟结果，可以考虑重新写代码的，因为，看懂别人的代码再修改，比自己直接写代码更耗时耗力

凤随心动

wdh540119878 发表于 2022-11-22 10:45
嗯嗯 我已经分成两个VB了  重新上传了 附件，麻烦您帮我看一下

两个宏里面都有关闭文件，那要改一下，怎么改那只能看你自己的逻辑了

wdh540119878

3190496160 发表于 2022-11-22 15:26
不要谈你的代码，因为，只看你的代码是没法完全清楚你的需求的，
具体描述你的需求，模拟结果，可以考虑重 ...

1、第二行上 插入2行空白行
2、F列前插入1列、C列前插入1列
3、合并A1:B1、A2:B2、D2:G2、D3:G3、H2:I2、H3:I3
4、A1:I1输入内容为“目录”
     A2:B2输入内容为“类别”
     C2输入内容为“卷号”
     D2:G2输入内容为“案卷题名”
     H2:I2输入内容为"保管期限"  
     A3:B3输入内容为"2008"     （点击运行后出现一个输入框，有填写内容的位置，可以自己填写内容、年度            ）这两行内容是有变化的
     H3:I3输入内容为"30年"    （点击运行后出现一个输入框，有填写内容的位置，可以自己填写内容、保管期限           ）这两行内容是有变化的
     "A4"输入内容为""序号"
     "B4:C4"输入内容为"责任者"
     "D4"输入内容为"文件号"
     "E4"输入内容为"文件题名"
     "F4"输入内容为"文件日期"
     "G4"输入内容为"何种文字"
     "H4"输入内容为"所在页码"
     "I4"输入内容为"备注"
5、A2-I4加普通边框
6、第一行宋体20号字、第二行到第四行宋体11号字、第五行到最后一行宋体10号字。
7、列宽：
        A列   3
        B列   5
        C列   5
        D列   8.5
        E列   31.5
        F列   9
        G列   5
        H列   4.5
        I列   3.5
8、行高：
         第1行     25.5
         第2行     35.1
         第3行     65.1
         第4行     45.95
9、合并B4:C4、B5:C5
10、复制B5:C5,选择B6—有内容的最后一行，选择性粘贴为 格式（或者合并B6:C6、B7:C7、B8:C8.........直至最后有内容的一行）
11、所有单元格改成文本格式

点击运行 输入  年度            、保管期限              可变的字符后  ，到选择文件夹的地方 选择文件夹后自动所有文件按顺序  执行



这个是原文件 格式




VBA完成后 是这个格式