背景:在工作中，客户对他们使用了很长时间的 Excel 宏有疑问。简而言之，该宏读取 .txt 文件，修剪掉 A 列中不包含值“22300”的行(从“Rekening”一词下方开始)添加与剩余行关联的数字的总值并生成一个结果的 Excel 文件。
当前结果:更改提供的 .txt 文件模板(微小更改)后，宏已停止工作。当用户启动宏(通过单击图像/形状)时，宏开始运行但给出 1004 错误(窗口错误)。当用户单击确定时，宏会继续生成 Excel 文件，但没有应用修剪功能并添加总值。
我已经仔细检查了文件中“Rekening”和“22300”的拼写。除此之外，我还尝试再次使用偏移值，但我不确定我在做什么，因为我对此很陌生。
Option Explicit
Sub OpenBestand()
Application.DisplayAlerts = False
Dim sBronMap As String
Dim sResultmap As String
Dim sDonemap As String
Dim sBronbest As String
Dim wbBron As Workbook
On Error GoTo Errorhandler
sBronMap = Blad1.Range("Bronmap").Value
If Right(sBronMap, 1) <> "\" Then sBronMap = sBronMap & "\"
sBronbest = Dir(sBronMap & "*.prt", vbNormal)
If sBronbest = "" Then
sBronbest = Dir(sBronMap & "*.txt", vbNormal)
End If
Application.DisplayAlerts = False
If sBronbest <> "" Then
With Application
.ScreenUpdating = False
.StatusBar = "Even geduld bezig met verwerken bestand " & sBronbest
End With
Workbooks.OpenText Filename:=sBronMap & sBronbest, _
Origin:=xlWindows, _
StartRow:=9, _
DataType:=xlFixedWidth, _
FieldInfo:=Array(Array(0, 1), _
Array(9, 1), _
Array(18, 1), _
Array(33, 1), _
Array(53, 1), _
Array(69, 2), _
Array(78, 1), _
Array(88, 1), _
Array(95, 1), _
Array(109, 1), _
Array(123, 1), _
Array(129, 1)), _
TrailingMinusNumbers:=True
Set wbBron = ActiveWorkbook
Bewerkbestand wbBron
Else
MsgBox "geen bestand gevonden", vbInformation, "Mededeling"
Exit Sub
End If
sResultmap = Blad1.Range("Resultmap").Value
If Right(sResultmap, 1) <> "\" Then sResultmap = sResultmap & "\"
wbBron.SaveAs sResultmap & Left(wbBron.Name, InStr(1, wbBron.Name, ".") - 1), xlWorkbookNormal
sDonemap = Blad1.Range("Donemap").Value
If Right(sDonemap, 1) <> "\" Then sDonemap = sDonemap & "\"
FileCopy sBronMap & sBronbest, sDonemap & sBronbest
Kill sBronMap & sBronbest
wbBron.Activate
With ActiveWindow
.ScrollColumn = 1
.ScrollRow = 1
End With
With Application
.ScreenUpdating = True
.StatusBar = False
End With
ThisWorkbook.Close SaveChanges:=False
Exit Sub
Errorhandler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Fout tijdens verwerking!"
With Application
.ScreenUpdating = True
.StatusBar = False
End With
End Sub
Sub Bewerkbestand(ByVal wbBron As Workbook)
On Error GoTo Errorhandler
Dim contrCel As Range, StartCel As Range
Dim TotBedr As Double
TotBedr = 0
Set contrCel = wbBron.Worksheets(1).Range("A1")
Do While UCase(Trim(contrCel.Value)) <> "Rekening"
Set contrCel = contrCel.Offset(1, 0)
Loop
Set StartCel = contrCel
Set contrCel = contrCel.Offset(2, 0)
Do While contrCel.Value & contrCel.Offset(1, 0).Value & contrCel.Offset(2, 0).Value <> ""
If contrCel.Value <> "22300" Then
Set contrCel = contrCel.Offset(-1, 0)
contrCel.Offset(1, 0).EntireRow.Delete
Else
End If
Set contrCel = contrCel.Offset(1, 0)
Loop
'Bedragen optellen
Set contrCel = StartCel.Offset(2, 0)
Do While contrCel.Value <> ""
TotBedr = TotBedr + CDbl(contrCel.Offset(0, 9).Value)
Set contrCel = contrCel.Offset(1, 0)
Loop
With StartCel
.Offset(-2, 8).Value = "Totaalbedrag"
.Offset(-2, 8).Font.Bold = True
.Offset(-2, 8).HorizontalAlignment = xlRight
.Offset(-2, 9).Value = TotBedr
.Offset(-2, 9).EntireColumn.ColumnWidth = 16
.Offset(-2, 9).Font.Bold = True
End With
Exit Sub
Errorhandler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Fout tijdens verwerking!"
End Sub
我已经包含了输入和所需/先前生成的输出的屏幕截图。
输入截图
所需/先前生成的输出
这是一个txt文件的内容(显然已编辑)以供引用:
A(s0V&k0V&l0o8V(s12.66A G X X X X E E E K V E E E E E K I I I I R E E E E E G
=================================================================================================================================
Integr.bestand: MEMO Periode: Dagb: Soci Zac Stap Bladnr: 1
=================================================================================================================================
Rekening Kostenpl. Kostendr. Rekeningnaam Omschrijving Boekstuk Datum Periode Debet Credit
=================================================================================================================================
RUNPARAMETERS
GEBRUIKER : Gxx
Gemo : 001
Financiele integratie Kup
Periode : 201907
Verslagnummer van : 180000
Verslagnummer t/m : 180022
Periode : 201907
Regeling(en) : 0 Regeling 1
1 Regeling 2
2 Regeling 3
3 Regeling 4
4 Regeling 5
5 Regeling 6
6 Regeling 7
7 Regeling 8
8 Regeling 9
9 Regeling 10
10 Regeling 11
11 Regeling 12
12 Regeling 13
13 Regeling 14
Boekingsdatum van : --
Boekingsdatum t/m : --
EINDE RUNPARAMETERS
G X X X X E E E K V E E E E E K I I I I R E E E E E G
=================================================================================================================================
Integr.bestand: MEMO Periode: Dagb: Soci Zac Stap Bladnr: 2
=================================================================================================================================
Rekening Kostenpl. Kostendr. Rekeningnaam Omschrijving Boekstuk Datum Periode Debet Credit
=================================================================================================================================
60XXXXXX 4XXXX NXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 1XX,XX
60XXXXXX 4XXXX IXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 7X,XX
60XXXXXX 4XXXX OXXXXXXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 8XXX,XX
22300 BXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 3XXX,XX
60XXXXXX 4XXXX EXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 6XXX,XX
22304 AXXXXXXXXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 6XXX,XX
60XXXXXX 4XXXX VXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 5XX,13
60XXXXXX 4XXXX RXXXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 5XX,XX
60XXXXXX 4XXXX LXXXXXXXXXXXXXXXXXX PXXX 0XXXXXXX 30-07-2019 201906 1XXXX,XX
------------- -------------
Totalen : 4XXX,XX 4XXX,XX
============= =============
最佳答案
主要问题在这一行
Do While UCase(Trim(contrCel.Value)) <> "Rekening"
您正在寻找
UCase表示单元格值中的所有字符都通过 UCase 转换为大写所以当谈到 Rekening你比较"REKENING" <> "Rekening"所以它不匹配。您需要将其更改为Do While UCase(Trim(contrCel.Value)) <> "REKENING"
但我建议使用 Range.Find method应该找到
"Rekening"比循环快。您可以使其不区分大小写 MatchCase:=False让它查看单元格的一部分LookAt:=xlPart所以你不需要Trim .Set StartCel = wbBron.Worksheets(1).Columns("A").Find(What:="Rekening", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
查看
Bewerkbestand 的完整改进代码程序如下:Sub Bewerkbestand(ByVal wbBron As Workbook)
On Error GoTo Errorhandler
Dim StartCel As Range
Set StartCel = wbBron.Worksheets(1).Columns("A").Find(What:="Rekening", LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
If StartCel Is Nothing Then
MsgBox "'Rekening' could not be found.", vbCritical
Exit Sub
End If
Dim contrCel As Range
Set contrCel = StartCel.Offset(2, 0)
Do While contrCel.Value & contrCel.Offset(1, 0).Value & contrCel.Offset(2, 0).Value <> ""
If contrCel.Value <> "22300" Then
Set contrCel = contrCel.Offset(-1, 0)
contrCel.Offset(1, 0).EntireRow.Delete
Else
End If
Set contrCel = contrCel.Offset(1, 0)
Loop
'Bedragen optellen
Set contrCel = StartCel.Offset(2, 0)
Dim TotBedr As Double
Do While contrCel.Value <> ""
TotBedr = TotBedr + CDbl(contrCel.Offset(0, 9).Value)
Set contrCel = contrCel.Offset(1, 0)
Loop
With StartCel
.Offset(-2, 8).Value = "Totaalbedrag"
.Offset(-2, 8).Font.Bold = True
.Offset(-2, 8).HorizontalAlignment = xlRight
.Offset(-2, 9).Value = TotBedr
.Offset(-2, 9).EntireColumn.ColumnWidth = 16
.Offset(-2, 9).Font.Bold = True
End With
Exit Sub
Errorhandler:
MsgBox Err.Number & " " & Err.Description, vbCritical, "Fout tijdens verwerking!"
End Sub
关于excel - 修剪功能无法正常工作，我做错了什么？，我们在Stack Overflow上找到一个类似的问题： https://stackoverflow.com/questions/57284744/