标签：Dim vba End String excel 汇总 myfile Integer Sub
'根据指定字符返回行号
'DataName 要搜索的数据信息
'SearchRowCount 搜索的行高
'SearchColumnCount 搜索的列宽
'RowIndex 开始行
'ColumnIndex 开始列
Public Function ReTurnRowNum(ModuleActiveWorkBook As Workbook, SheetName As String, _
DataName As String, SearchRowCount As Integer, SearchColumnCount As Integer, _
Optional RowIndex As Integer = 1, Optional ColumnIndex As Integer = 1) As Integer
ModuleActiveWorkBook.Activate
Sheets(SheetName).Activate
Dim i As Integer
Dim j As Integer
Dim a As String
i = RowIndex
j = ColumnIndex
Do Until i > SearchRowCount
For j = ColumnIndex To SearchColumnCount
If Cells(i, j).Value = DataName Then '更精准可以用Instr，多个条件，或者 用正则表达式
If Cells(i, j).MergeCells = True Then
ReTurnRowNum = i
Exit Do
Exit For
Exit Do
Else: ReTurnRowNum = 0
End If
' ElseIf Cells(i, j).Value = DataName And InStr(1, Cells(i, j).Value, "订单号", 0) = 0 And InStr(1, Cells(i, j).Value, "交货日期", 0) = 0 Then
' ReTurnRowNum = i
' Exit Do
' Exit For
' Exit Do
Else: ReTurnRowNum = 0
End If
Next
i = i + 1
Loop
End Function
正则表达式：^[\s\S]*[L]+[C]+[S]+[\s]*[0-9]+[A]+[\s]*[D]+[A]+[T]+[A]+[\s\S]*$
正则表达式：^[\s\S]*[0-9a-zA-Z]+[楼]{1}[到]{1}[0-9]+[楼]{1}[的]{1}[楼]{1}[层]{1}[间]{1}[距]{1}[:]{1}[\s\S]*$
\w匹配的仅仅是中文，数字，字母，对于国人来讲，仅匹配中文时常会用到匹配中文字符的正则表达式：[\u4e00-\u9fa5]
或许你也需要匹配双字节字符，中文也是双字节的字符匹配双字节字符(包括汉字在内)：[^\x00-\xff]
'文件操作模块
'thisWorkbooks 代码所在excel工作簿
'ActivateWorkbook 当前活跃的excel工作簿
'当前打开的所有工作簿中，关闭指定工作簿
Public Sub CloseFile(FileName As String)
Dim bk As Workbook
For Each bk In Application.Workbooks
If bk.name = FileName Then
Workbooks(FileName).Save
Workbooks(FileName).Close
End If
Next
End Sub
'将路径文件夹中的 条码.xlsx 文件删除
Dim CurrentFilePath As String: CurrentFilePath = ThisWorkbook.Path
Dim myfile
Dim day As String: day = Format(Now(), "YYYY-MM-DD")
myfile = Dir(CurrentFilePath & "\*.xlsx") '提取文件路径中的所有文件，此时返回第一个文件的名字
Do While myfile <> "" '当文件名不为空时，循环提取文件名
If InStr(1, myfile, day, 0) > 0 Then 'Left(Name,Instr(name,".")-1)
Dim bk As Workbook
For Each bk In Application.Workbooks
If bk.name = myfile Then
Workbooks(myfile).Close
End If
Next
Kill CurrentFilePath & "\" & myfile
End If
myfile = Dir
Loop
MsgBox "删除完成"
End Sub
'将文件夹中所有文件名逐一写入到OrderFileName()数组中
Public Sub GetOrderFileNameToArray(OrderFilePath As String)
Dim myfile
Dim n As Integer: n = 1
myfile = Dir(OrderFilePath & "\*.*") '提取文件路径中的所有文件，此时返回第一个文件的名字
Do While myfile <> "" '当文件名不为空时，循环提取文件名
ReDim Preserve OrderFileName(1 To n)
OrderFileName(n) = myfile
n = n + 1
myfile = Dir
Loop
End Sub
'按照OrderFileName()数组中的数据逐一生成excel sheet表
Public Sub CreateOrderSheet(SheetOrderFileName() As String, ModuleActiveWorkBook As Workbook)
ModuleActiveWorkBook.Activate
Dim UIndex As Integer
Dim i As Integer
UIndex = UBound(OrderFileName)
For i = 1 To UIndex
Sheets("Sheet1").Copy Before:=Sheets("Sheet1")
Dim name() As String
name = Split(OrderFileName(i), ".")
ActiveSheet.name = name(0)
Sheets(name(0)).Tab.Color = 255
Next
End Sub
'文件复制
Public Sub ModuleFileCopy(SourceFilePath As String, DestinationFilePath As String)
FileCopy SourceFilePath, DestinationFilePath
End Sub
通过Access sql 的方式去处理数据。
Sub Select_Group1()
Dim cnn As New ADODB.Connection '创建Connection对象，该对象代表了Excel与后面指定数据库的连接
Dim rst As ADODB.Recordset '创建Recordset对象，该对象用来保存执行SQL语句后生成的数据集
Dim SQL As String
Dim i As Integer
Dim mypath As String
On Error GoTo ErrMsg '
mypath = ThisWorkbook.FullName
cnn.Open "Provider=Microsoft.Ace.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & mypath '使用Connection对象的Open方法来连接指定数据库与数据表的位置
SQL = " select * from table1"
Set rst = cnn.Execute(SQL) '执行SQL语句
Worksheets(2).Select
Worksheets(2).Activate
Worksheets(2).UsedRange.ClearContents
'Cells.ClearContents ‘在Excel中放置数据
For i = 0 To rst.Fields.Count - 1
Cells(1, i + 1) = rst(i).name
Next
Range("a2").CopyFromRecordset rst
rst.Close
cnn.Close
Set rst = Nothing
Set cnn = Nothing
Exit Sub
ErrMsg:
MsgBox Err.Description, , "Description of Error"
End Sub
'根据指定字符返回数组 一维 杂项 这个是用正则表达式的
Public Function ReTurnArrayData(ModuleActiveWorkBook As Workbook, SheetName As String, RegPattern As String, _
SearchRowCount As Integer, SearchColumnCount As Integer, _
Optional RowIndex As Integer = 1, Optional ColumnIndex As Integer = 1) As String()
ModuleActiveWorkBook.Activate
Sheets(SheetName).Activate
Dim i As Integer
Dim j As Integer
Dim a As String
i = RowIndex
j = ColumnIndex
Dim ReTurnArrayDataInFunc() As String
ReDim ReTurnArrayDataInFunc(1 To SearchColumnCount - 1) As String
Do Until i > SearchRowCount
For j = ColumnIndex To SearchColumnCount
Dim mRegExp As Object
Dim mMatches As MatchCollection '匹配字符串集合对象
Dim mMatch As Match '匹配字符串
Set mRegExp = New RegExp
mRegExp.Global = True 'True表示匹配所有, False表示仅匹配第一个符合项
mRegExp.IgnoreCase = True 'True表示不区分大小写, False表示区分大小写
mRegExp.Pattern = RegPattern
If mRegExp.Test(Cells(i, j).Value) Then
Cells(i, j).Interior.ColorIndex = 42
Dim ReTurnRowNumInFunc As Integer
For ReTurnRowNumInFunc = 1 To SearchColumnCount - 1
ReTurnArrayDataInFunc(ReTurnRowNumInFunc) = Cells(i, ReTurnRowNumInFunc + 1).Value
Next
ReTurnArrayData = ReTurnArrayDataInFunc
Exit Do
Exit For
Exit Do
Else:
End If
Next
i = i + 1
Loop
Set mRegExp = Nothing
Set mMatches = Nothing
End Function
标签：Dim,vba,End,String,excel,汇总,myfile,Integer,Sub 来源： https://blog.csdn.net/qq_37326058/article/details/94435997
本站声明： 1. iCode9 技术分享网（下文简称本站）提供的所有内容，仅供技术学习、探讨和分享； 2. 关于本站的所有留言、评论、转载及引用，纯属内容发起人的个人观点，与本站观点和立场无关； 3. 关于本站的所有言论和文字，纯属内容发起人的个人观点，与本站观点和立场无关； 4. 本站文章均是网友提供，不完全保证技术分享内容的完整性、准确性、时效性、风险性和版权归属；如您发现该文章侵犯了您的权益，可联系我们第一时间进行删除； 5. 本站为非盈利性的个人网站，所有内容不会用来进行牟利，也不会利用任何形式的广告来间接获益，纯粹是为了广大技术爱好者提供技术内容和技术思想的分享性交流网站。