Excel/VBA 宏清除列中的内容 如果值小于 10000，则打开/保存在新文件中/关闭

Question

我对宏相当陌生，但我想写一个打开.csv文件的宏。然后，如果某个列中的值小于 10000，则清除单元格内容。然后，保存它并将其放入新的 csv 文件中。我的脚本是Stackoverflow上几个主题的混合。

我试着写它，得出了这个：

Sub RemoveSmallValues()
Dim wb As Workbook
Dim myfilename As String
myfilename = "C:Snapshot.csv"
'~~> open the workbook and pass it to workbook object variable
Set wb = Workbooks.Open(myfilename)
Dim r As Range, N As Long
Set r = ActiveSheet.Range("B1:B10")
N = Cells(Rows.Count, "C").End(xlUp).Row
For i = 1 To N
BB = Cells(i, "B").Value
If BB <= 10000 Then Range(BB).ClearContents
End If
Next i
Dim newfilename As String
newfilename = "C:SnapshotBB.csv"
'~~> If you are saving it in a format other than .xlsx,
'~~> you have to be explicit in the FileFormat argument
wb.SaveAs newfilename, FileFormat:=xlOpenXMLWorkbook
wb.Close
End Sub

如果你能帮我，那就太好了！

Answer 1

看看下面。我不确定您想要的某些值，因此请在对实时数据使用之前对其进行测试。

使用此代码。请将以下内容复制并粘贴到模块中。

我也做了很多假设，比如：

1. C 列中没有用于行计数的空白单元格
2. 您的原始CSV文件中没有标题(如果不是这样，请参阅注释以进行调整)。

谢谢

Sub RemoveSmallValues()
Dim myfilename As String
Dim myfilepath As String
Dim newfilename As String
Dim N As Long
Dim i As Long
Dim cellvalue As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'The above is just standard lines that I normally put into my code, enchances the speed of the macro.
myfilepath = "C:Snapshot.csv"
myfilename = "Snapshot.csv"
Workbooks.Open (myfilepath)
Workbooks(myfilename).Activate 'Makes SnapShot.csv the active workbook
N = Range("C1", Range("C1").End(xlDown)).Rows.Count
'counts the number of rows untill cell is BLANK, based on your code I used Column C.
'If your columns have headers then you will need to make this C2. Otherwise your headers will be included and will create a datatype error on CELLVALUE
For i = 1 To N 'Again if your columns have hearders, then i will need to be i = 2
cellvalue = Cells(i, 2).Value
If cellvalue <= 10000 Then Cells(i, 2).ClearContents
Next i
newfilename = "C:SnapshotBB" 'new file path and file name without extension.
Workbooks(myfilename).SaveAs newfilename, FileFormat:=xlCSV 'Save the file with extension CSV
ActiveWorkbook.Close False 'Close the workbook without saving, as you have already saved the workbook with line before.
End Sub

Answer 2

CSV 噩梦

分号 (;)

问题是我的系统默认使用分号作为分隔符保存csv文件。Excel将正常打开文件，但VBA将通过将所有列中的数据放入列A来打开文件。解决方法是检查列数。如果只有一列包含数据，则OpenText方法与Local:=True一起使用。现在，剩下的问题是VBA会将文件保存为逗号分隔，无论是否Local:=True，因此当我在Excel中打开它时，它将打开第A列中的所有列。

《守则》

Sub RemoveSmallValues()
' Path of Source and Target Files
Const myPath As String = "D:ExcelMyDocumentsStackOverflowMyAnswersTest"
Const myFile As String = "Snapshot.csv"     ' Source File Name
Const newFile As String = "SnapshotBB.csv"  ' Target File Name
Const myColumn As String = "B"    ' Source/Target Column
Const myLRColumn As String = "C"  ' Last-Row Column Letter
Const FR As Long = 1              ' First Row Number
Const cCrit As Long = 10000       ' Criteria Value
Dim wb As Workbook    ' Source Workbook
Dim rng As Range      ' Cell Ranges
Dim LR As Long        ' Last Row
Dim BB As Long        ' Current Value
Dim i As Long         ' Source Worksheet Row Counter
Dim FPath As String   ' Full Path
' Check if Source Workbook is already open.
For Each wb In Workbooks
' Source Workbook is open, stop looping.
If wb.Name = myFile Then Exit For
Next
' Calculate Full Path.
FPath = myPath & "" & myFile
' Check if Source Workbook is not open.
If wb Is Nothing Then
' Handle error if Source Workbook could not be found.
On Error Resume Next
' Create a reference to Source Workbook.
Set wb = Workbooks.Open(FPath)
' Check if Source Workbook could not be found.
If Err Then   ' Inform user and exit.
MsgBox "The file '" & myFile & "' could not be found in folder '" _
& myPath & "'.", vbCritical, "File not found"
Exit Sub
End If
On Error GoTo 0
End If
' Calculate Last Column in Source Worksheet.
Set rng = wb.ActiveSheet.Cells.Find("*", , xlValues, xlWhole, _
xlByColumns, xlPrevious)
' Check if all values are in first column.
If rng.Column = 1 Then
' Open Source Workbook as delimited file.
Workbooks.OpenText Filename:=FPath, _
DataType:=xlDelimited, Local:=True
' Create a reference to Source Workbook.
Set wb = ActiveWorkbook
' Calculate Last Column in Source Worksheet.
Set rng = wb.ActiveSheet.Cells.Find("*", , xlValues, xlWhole, _
xlByColumns, xlPrevious)
' Check if all values are still in first column.
If rng.Column = 1 Then   ' Inform user and exit.
MsgBox "The file '" & myFile & "' in folder '" & myPath _
& "' is of an unsupported format.", vbCritical, _
"Unsupported format"
Exit Sub
End If
End If
With wb.ActiveSheet
' Calculate Last Row in Source Worksheet.
LR = .Cells(.Rows.Count, myLRColumn).End(xlUp).Row
' Loop through rows of Source Worksheet.
For i = FR To LR
' Check if the value in current cell is a number.
If IsNumeric(.Cells(i, myColumn).Value) Then
' Write value of current cell to Current Value.
BB = .Cells(i, myColumn).Value
' Check if Current Value meets Criteria.
If BB <= cCrit Then .Cells(i, myColumn).ClearContents
End If
Next
On Error Resume Next
' Save modified Source File as Target File.
' Note: This will save the file as COMMA separated anyway, no matter
'       of the value of Local. Should be investigated.
.SaveAs Filename:=myPath & "" & newFile, _
FileFormat:=xlCSV ', Local:=True ' This doesn't seem to help.
' Close Target File.
.Parent.Close False
On Error GoTo 0
End With
' Inform user of success.
MsgBox "Operation finished successfully.", vbInformation, "Success"
End Sub