求学代码

施学明 · 发表于 2024-9-9 13:12

需求：程序在“转换”工作簿中运行

1删除“批量下拨”工作簿中“批量下拨”工作表中的空值所在行

2根据“转换”工作簿中“转换”中b2单元格数值（这个数值是可变的）每取“批量下拨”工作表数据行数后另存到“下拨批次”文件夹中（文件名为“当前日期“加“批量下拨”加“01”等序号），

3将“下拨批次”文件夹下的所有含有“批量下拨”文件名的工作簿中“批量下拨”工作表中数据复制到“批量调拨模版”的工作簿中，然后分别另存为到“2024”文件夹下与原xlsx同名的97-2003的工作簿（将原来的xlsx文件直接打开另存为xls工作簿不好导入数据库）

4清除“批量下拨”工作簿中“批量下拨”工作表数据，清除“批量调拨模版”工作簿中数据，删除“下拨批次”文件下的文件，以便每日更新，保存“2024”文件夹下文件

3190496160 · 发表于 2024-9-9 19:58

删除“批量下拨”工作簿中“批量下拨”工作表中的空值所在行
这句话该如何理解呢？根据什么来判断空值？？

ykcbf1100 · 发表于 2024-9-9 20:55

需求1：工作表中的空值，指的是哪一列的值啊？

施学明 · 发表于 2024-9-9 21:33

ykcbf1100 发表于 2024-9-9 20:55
需求1：工作表中的空值，指的是哪一列的值啊？

不好意思，是d列金额为0所在行

施学明 · 发表于 2024-9-10 13:27

有大侠能帮忙不？

ykcbf1100 · 发表于 2024-9-10 19:33

施学明发表于 2024-9-10 13:27
有大侠能帮忙不？

完成第一需求，删除空行。

ykcbf1100 · 发表于 2024-9-10 19:34

删除空行。

Sub ykcbf() '//2024.9.10
Application.ScreenUpdating = False
Application.DisplayAlerts = False
p = ThisWorkbook.Path & ""
f = p & "批量下拨.xlsm"
Set wb = Workbooks.Open(f, 0)
Set Rng = Nothing
With wb.Sheets(1)
r = .Cells(Rows.Count, 1).End(3).Row
For i = 2 To r
If Val(.Cells(i, 4).Value) = 0 Then
If Rng Is Nothing Then
Set Rng = .Rows(i)
Else
Set Rng = Union(Rng, .Rows(i))
End If
End If
Next
If Not Rng Is Nothing Then Rng.EntireRow.Delete
End With
wb.Close 1
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

复制代码

施学明 · 发表于 2024-9-10 20:56

ykcbf1100 发表于 2024-9-10 19:34
删除空行。

谢谢你的全力相助，我认真学习下

3190496160 · 发表于 2024-9-11 08:33

Sub 提取数据()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ar As Variant
Dim i As Long, r As Long
hs = [b2]
If hs = "" Then MsgBox "请输入要提取的行数！": End
lj = ThisWorkbook.Path & "\"
f = Dir(lj & "批量下拨.xls*")
If f = "" Then MsgBox "找不到批量下拨文件！": End
Set wb = Workbooks.Open(lj & f, 0)
With wb.Worksheets(1)
r = .Cells(Rows.Count, 1).End(xlUp).Row
ar = .Range("a1:s" & r)
End With
wb.Close False
ReDim br(1 To hs, 1 To UBound(ar, 2))
For i = 2 To UBound(ar)
If ar(i, 4) <> "" Then
      If IsNumeric(ar(i, 4)) Then
         If ar(i, 4) <> 0 Then
            n = n + 1
            If n > hs Then GoTo 10
            For j = 1 To UBound(ar, 2)
                  br(n, j) = ar(i, j)
            Next j
         End If
      End If
End If
Next i
10:
Set f = Nothing
Set wb = Nothing
f = Dir(lj & "2024\*.xls*")
m = 0
zd = Format(Date, "yyyymmdd") & "批量下拨"
Do While f <> ""
If InStr(f, zd) > 0 Then
      m = m + 1
End If
f = Dir
Loop
Set wb = Workbooks.Open(lj & "批量调拨(模版）.xls", 0)
With wb.Worksheets(1)
.[a2].Resize(hs, UBound(br, 2)) = br
End With
wb.SaveAs Filename:=lj & "2024\" & zd & m + 1 & ".xls"
wb.Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160 · 发表于 2024-9-11 08:34

直接一步到位就行了，没有必要如你这般繁琐的

需求资料.rar (62.19 KB, 下载次数: 1)

		自动登录	找回密码
密码			免费注册

[求助] 求学代码

评分