VBA 实用语句

VBA 实用语句

文件

SHEET页

输出sheet页总数

Sub shis()

Dim xlBook As Excel.Workbook
Set xlBook = ThisWorkbook
MsgBox xlBook.Sheets.Count
End Sub

copy一个sheet 并paste到一个新建的sheet

ActiveWorkbook.Sheets("sheet1").Copy after:=Worksheets(Worksheets.Count) '新建的sheet在最后
ActiveSheet.Name = "新建的sheet名"

删除sheet

Application.DisplayAlerts = False
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True

取sheet页数

totalSheet = WorkbookWrite.Worksheets.Count

子元素

大小写

'使其英文字段全部小写 大写是UCase
 sheet.Cells(j, 13) = LCase(sheet.Cells(j, 13))

截取字符串，去空格

Sub SHI2()

Dim cellValue
Dim cellLength As Integer
    //去空格，只能去左右空格 不能去中间的
cellValue = Trim(Sheets(1).Cells(12, 1).Value)
cellLength = Len(cellValue)

If cellLength > 8 Then
        //第一个开始，截8个
If UCase(Mid(cellValue, 1, 8)) = "VARCHAR2" Then


cellLength = Len(cellValue)
End If
End If
End Sub

字符所在位置

startL = InStr(WorkbookRead.Sheets("所有字段").Cells(k, 8), "(") + 1

取字符长度

len("aaa")

取头掐尾

Sub shishi3()
If "CHAR(4)" Like "CHAR*" Then

startL = InStr("CHAR(4)", "(") + 1
      endL = InStr("CHAR(4)", ")")

    MsgBox Mid("CHAR(4)", startL, endL - startL)


End If

Function getLength3(dataText As String, dataType As String) As Integer

 If Len(dataText) > (Len(dataType) + 2) Then
      startL = InStr(dataText, ",") + 1
      endL = InStr(dataText, ")")
      getLength = CInt(Mid(dataText, startL, endL - startL))
 End If


End Function

字符串转数值

CInt('xxxxx')

给合并单元格值

WorkbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula

干掉空白行

    '干掉空白行
         
    For b = sheetCount To 1 Step -1
    
    workbookWrite.Worksheets(b).Select
    totalRowAllstart = workbookWrite.Sheets(b).Range("C65536").End(xlUp).Row
    totalRowAllend = workbookWrite.Sheets(b).UsedRange.Rows.Count
    
        For i = totalRowAllend To totalRowAllstart Step -1
        'If Application.WorksheetFunction.CountA(workbookWrite.Sheets(b).Rows(i)) = 0 Then
        '    workbookWrite.Sheets(b).Rows(i).Delete
      '  End If
        
            If Trim(workbookWrite.Sheets(b).Cells(i, 1)) = "" Then
            workbookWrite.Sheets(b).Rows(i).Delete
            End If
        
    Next i
    
    Next b

开发整体使用代码

Private Sub Label2_Click()

End Sub

Private Sub submit_Click()




    Dim dataExcel, Workbook, sheet
    Dim pathRead
    Dim pathWrite
    Dim totalRow As Integer
    Dim totalRow2 As Integer
    Dim sheetCount As Integer
    Dim startRow As Integer
 
    pathRead = TextBox1.Value
    pathWrite = TextBox2.Value
   
   '根据目录 新建sheet页
   Set dataExcel = CreateObject("Excel.Application")
   Set WorkbookRead = dataExcel.Workbooks.Open(pathRead)
   Set workbookWrite = dataExcel.Workbooks.Open(pathWrite)
   dataExcel.Visible = True
    'MsgBox WorkbookRead.Sheets("目录").Range("B65536").End(xlUp).Row
   'totalRow = WorkbookRead.Sheets("目录").Range("B65536").End(xlUp).Row
   'For j = 3 To totalRow
   '         workbookWrite.Sheets("模板表").Copy after:=workbookWrite.Worksheets(Worksheets.Count) '新建的sheet在最后
   '         workbookWrite.Worksheets(Worksheets.Count + 1).Name = WorkbookRead.Sheets("目录").Cells(j, 3)
  ' Next j
    workbookWrite.Application.DisplayAlerts = False
   ' workbookWrite.Sheets("模板表").Delete
    
   
    
    
    '根据 所有字段 给sheet页添加内容
     sheetCount = workbookWrite.Worksheets.Count
    totalRow2 = WorkbookRead.Sheets("所有字段").Range("C65536").End(xlUp).Row
    For i = 1 To sheetCount Step 1
    
    workbookWrite.Worksheets(i).Select
    workbookWrite.Worksheets(i).Cells(1, 1).Select
    '文书编号/名称
     workbookWrite.Worksheets(i).Cells(3, 14) = workbookWrite.Worksheets(i).Name
   
     
     
     writeNum_temp = 9
    For k = 2 To totalRow2
   If workbookWrite.Worksheets(i).Name = WorkbookRead.Sheets("所有字段").Cells(k, 3) Then
   
     

   
    '表中文名
   ' if workbookWrite.Worksheets(i).Name <> WorkbookRead.Sheets("所有字段").Cells(k, 20)
    'workbookWrite.Worksheets(i).Name = WorkbookRead.Sheets("所有字段").Cells(k, 20)
   
   
   '表中文名（cell）
       Name = WorkbookRead.Sheets("所有字段").Cells(k, 20)
     workbookWrite.Worksheets(i).Cells(6, 15) = WorkbookRead.Sheets("所有字段").Cells(k, 20)
     workbookWrite.Worksheets(i).Cells(3, 14) = WorkbookRead.Sheets("所有字段").Cells(k, 20)
    
    '表英文名
    workbookWrite.Worksheets(i).Cells(6, 4) = WorkbookRead.Sheets("所有字段").Cells(k, 21)
    '顺序号 k+6=9
    workbookWrite.Worksheets(i).Cells(writeNum_temp, 1) = writeNum_temp - 8
    '字段名
  workbookWrite.Worksheets(i).Cells(writeNum_temp, 2) = WorkbookRead.Sheets("所有字段").Cells(k, 5)
 
   
   '字段英文名
   workbookWrite.Worksheets(i).Cells(writeNum_temp, 13) = WorkbookRead.Sheets("所有字段").Cells(k, 6)
   
    
    
    '属性
      workbookWrite.Worksheets(i).Cells(writeNum_temp, 23) = WorkbookRead.Sheets("所有字段").Cells(k, 8)
    '属性长度-------------------------------start------------------------
    
     ' If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "char*" And Len(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8))) > (Len("char") + 2) Then
      'startL = InStr(WorkbookRead.Sheets("所有字段").Cells(k, 8), "(") + 1
      'endL = InStr(WorkbookRead.Sheets("所有字段").Cells(k, 8), ")")
    '  WorkbookWrite.Worksheets(i).Cells(writeNum_temp, 25) = Mid(WorkbookRead.Sheets("所有字段").Cells(k, 8), startL, endL - startL)
         'MsgBox getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "char")
        ' MsgBox getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "char")
        
        
       If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "char*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 28).Formula = getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "char")
       End If
      If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "tinyint*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula = getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "tinyint")
       End If
       
       If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "bigint*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula = getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "bigint")
       End If
       
       
       If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "varchar*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 28).Formula = getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "varchar")
       End If
       
       
       If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "varchar2*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 28).Formula = getLength(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "varchar2")
       End If
       
       'decimal(3,2)
       If LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)) Like "decimal*" Then
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula = getLength2(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "decimal")
         
         workbookWrite.Worksheets(i).Cells(writeNum_temp, 26).Formula = getLength3(LCase(WorkbookRead.Sheets("所有字段").Cells(k, 8)), "decimal")
       End If
       
       
      'If WorkbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula = 0 Then
     ' WorkbookWrite.Worksheets(i).Cells(writeNum_temp, 24).Formula = ""
      'End If
      
       '属性长度-------------------------------end------------------------
      'PK
      If WorkbookRead.Sheets("所有字段").Cells(k, 9) = "Y" Then
      workbookWrite.Worksheets(i).Cells(writeNum_temp, 30) = "●"
      End If
      
      
      'Not Null
       If WorkbookRead.Sheets("所有字段").Cells(k, 10) = "Y" Then
       workbookWrite.Worksheets(i).Cells(writeNum_temp, 19) = "Y"
       Else
        workbookWrite.Worksheets(i).Cells(writeNum_temp, 19) = "N"
       End If
      
      
      
      
      
      writeNum_temp = writeNum_temp + 1
  
     End If
    Next k
     workbookWrite.Worksheets(i).Name = Name
    
     
    Next i
    
    
    '干掉空白行
         
  '  For b = sheetCount To 1 Step -1
    
  '  workbookWrite.Worksheets(b).Select
  '  totalRowAllstart = workbookWrite.Sheets(b).Range("C65536").End(xlUp).Row
   ' totalRowAllend = workbookWrite.Sheets(b).UsedRange.Rows.Count
    
    '    For i = totalRowAllend To totalRowAllstart Step -1
        'If Application.WorksheetFunction.CountA(workbookWrite.Sheets(b).Rows(i)) = 0 Then
        '    workbookWrite.Sheets(b).Rows(i).Delete
      '  End If
        
            'If Trim(workbookWrite.Sheets(b).Cells(i, 1)) = "" Then
           ' workbookWrite.Sheets(b).Rows(i).Delete
           ' End If
        
  '  Next i
    
 '   Next b
    
    
    
    
    
    workbookWrite.SaveAs ("C:\code\结果数据集" & startRow & ".xlsx")
    workbookWrite.Application.DisplayAlerts = True
    workbookWrite.Close
     WorkbookRead.Close
    MsgBox "运行成功"



End Sub

Private Sub TextBox2_Change()

End Sub


Sub SHI2()

Dim cellValue
Dim cellLength As Integer

cellValue = Trim(Sheets(1).Cells(12, 1).Value)
cellLength = Len(cellValue)

If cellLength > 8 Then
If UCase(Mid(cellValue, 1, 8)) = "VARCHAR2" Then


cellLength = Len(cellValue)
End If
End If
End Sub

Sub shishi3()



End Sub


Function getLength(dataText As String, dataType As String) As Integer

 If Len(dataText) > (Len(dataType) + 2) Then
      startL = InStr(dataText, "(") + 1
      endL = InStr(dataText, ")")
      getLength = CInt(Mid(dataText, startL, endL - startL))
 End If


End Function




Function getLength2(dataText As String, dataType As String) As Integer

 If Len(dataText) > (Len(dataType) + 2) Then
      startL = InStr(dataText, "(") + 1
      endL = InStr(dataText, ",")
      getLength2 = CInt(Mid(dataText, startL, endL - startL))
 End If


End Function


Function getLength3(dataText As String, dataType As String) As Integer

 If Len(dataText) > (Len(dataType) + 2) Then
      startL = InStr(dataText, ",") + 1
      endL = InStr(dataText, ")")
      getLength3 = CInt(Mid(dataText, startL, endL - startL))
 End If


End Function

函数

Sub shishi3()
result = aa("1")
MsgBox result

End Sub


Function aa(a As String) As String
    '返回结果和函数名相同
aa = a & "adsfa"

End Function