我已尽力浏览整个网站以获得答案,但没有任何运气 - 或者我不确切知道我在寻找什么。
我的问题是我有一张4张的XL工作簿;一个将保存原始数据,另外三个将使用VLookup来填充表格 - 这很好。 现在我运行VBA宏:
表格应该做的事情如下:
1:获取工作簿中每个工作表的内容,并将每个工作簿保存为CSV 2:运行A1:A1000,如果找到单词NUKE,则删除entier行。 3:再次保存工作表。
可能会遇到的一个问题是数据被复制为公式,但工作表的保存就是值。
编辑: 我道歉,我没有提到我遇到的问题。行未删除。
Public Sub SaveWorksheetsAsCsv()
Dim WS As Worksheet
Dim SaveToDirectory As String, newName As String
SaveToDirectory = "C:\jgd\"
For Each WS In ThisWorkbook.Worksheets
newName = GetBookName(ThisWorkbook.Name) & "_" & WS.Name
WS.Copy
ActiveWorkbook.SaveAs SaveToDirectory & newName, xlCSV
Call RemoveRows
ActiveWorkbook.Close Savechanges:=True
Next
Call Msg_exe
End Sub
Function GetBookName(strwb As String) As String
GetBookName = Left(strwb, (InStrRev(strwb, ".", -1, vbTextCompare) - 1))
End Function
Sub CheckDir()
Dim strPath As String
Dim lCtr As Long
strPath = "C:\jgd\"
arrpath = Split(strPath, "\")
strPath = arrpath(LBound(arrpath)) & "\"
For lCtr = LBound(arrpath) + 1 To UBound(arrpath)
strPath = strPath & arrpath(lCtr) & "\"
If Dir(strPath, vbDirectory) = "" Then
MkDir strPath
End If
Next
Call SaveWorksheetsAsCsv
End Sub
Sub RemoveRows()
Dim i As Long
i = 1
Do While i <= ThisWorkbook.ActiveSheet.Range("A1").CurrentRegion.Rows.Count
If InStr(1, ThisWorkbook.ActiveSheet.Cells(i, 1).Text, "NUKE", vbTextCompare) > 0 Then
ThisWorkbook.ActiveSheet.Rows(i).EntireRow.Delete
Else
i = i + 1
End If
Loop
End Sub
Sub Msg_exe()
Dim Ret_type As Integer
Dim strMsg As String
Dim strTitle As String
strMsg = "Conversion is complete." & vbCrLf & "Do you want to open the destination folder?"
strTitle = "Conversion Complete"
Ret_type = MsgBox(strMsg, vbYesNo + vbQuestion, strTitle)
Select Case Ret_type
Case 6
Call Shell("explorer.exe" & " " & "c:\jgd", vbNormalFocus)
End Select
End Sub
非常感谢任何帮助。