'根据指定字符返回行号
'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