列中的Excel / VBA宏ClearContents如果值小於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

看看下面。 我不確定您想要的某些值，因此請在使用LIVE數據之前先進行測試。

要使用此代碼。 請復制以下內容並將其粘貼到模塊中。

我也做了很多假設，例如：

1. C列中沒有ROW COUNT的BLANK單元格
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:\Excel\MyDocuments\StackOverflow\MyAnswers\Test"
    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