蜜臀99一区,国产日韩高清在线

視頻地址：https://www.bilibili.com/video/BV1gr4y137WY?p=2&vd_source=e90914683379d45ef4287d44b4e7363a
視頻作者：老吳
前提準備：

image.png

變量：

image.png

變量數(shù)據(jù)類型：

image.png

對象：

image.png

對象的表達方法：

image.png

屬性：

image.png

方法：

image.png

IF語句：

image.png

Sub test()
    Dim n1%, n2%
    n1 = 1
    n2 = 3
    If n1 < n2 Then
     MsgBox "n1小于n2"
    End If
End Sub

image.png

Sub test()
    Dim n As Byte
    n = InputBox("請輸入成績")
    If n > 60 And n < 100 Then
        MsgBox "成績合格"
    ElseIf n < 60 And n > 0 Then
        MsgBox "成績不合格"
    End If
End Sub

image.png

Sub test()
    If Cells(1, 1) > 150 Then
        Cells(1, 2) = "高級"
    ElseIf Cells(1, 1) > 100 Then
        Cells(1, 2) = "中級"
    Else
        Cells(1, 2) = "低級"
    End If
End Sub

FOR循環(huán)：

image.png

END獲取數(shù)據(jù)邊界：

image.png

Sub test()
    MsgBox Range("a1").End(xlDown).Row
    MsgBox Range("a1").End(xlToRight).Column
End Sub

ROW和ROWS的區(qū)別：

image.png

Sub test()
    MsgBox Rows.Count
    MsgBox Columns.Count
End Sub

image.png

usedrange:

image.png

Sub test()
    MsgBox ActiveSheet.UsedRange.Rows.Count
    MsgBox ActiveSheet.UsedRange.Columns.Count
End Sub

currentregion:

image.png

Sub test()
    Dim rowsCount%, columnsCount%, i%, j%
    rowsCount = Range("a1").CurrentRegion.Rows.Count
    columnsCount = Range("a1").CurrentRegion.columns.Count
    For i = 1 To rowsCount
        For j = 2 To columnsCount Step 2
            If Cells(i, j) < 60 Then
                Cells(i, j).Interior.ColorIndex = 3
            End If
        Next
    Next
End Sub

image.png

Sub test()
    Dim ws As Worksheet, i%
    For Each ws In Worksheets
        i = i + 1
        ws.Name = i
    Next
End Sub

image.png

Sub test()
    Range("a2").Resize(2, 3).Select
End Sub

image.png

Sub test()
    Dim allRangeB As Range, rng As Range
    Set allRangeB = Range("b1", Range("b1").End(xlDown))
    For Each rng In allRangeB
        If rng > 60 Then
            rng.Offset(0, -1).Resize(1, 4).Interior.ColorIndex = 3
        End If
    Next
End Sub

image.png

Sub test()
    Dim rngs As Range, tempRange As Range, locationRange As Range, copyRange As Range
    Set rngs = Range("b1", Range("b1").End(xlDown))
    For Each tempRange In rngs
        If tempRange.Value = "牛肉" Then
            n = n + 1
            If n <= 3 Then
                Set locationRange = Cells(Rows.Count, "d").End(xlUp).Offset(1, 0)
                Set copyRange = tempRange.Offset(0, -1).Resize(1, 2)
                copyRange.Copy locationRange
            Else
                Exit For
            End If
        End If
    Next
End Sub

image.png

Sub test()
    Dim answer%
    Do
        answer = InputBox("please write down the right answer")
        If answer = 7 Then
            MsgBox "the answer is wrong"
        Else
            MsgBox "the answer is right"
        End If
    Loop
End Sub

image.png

Sub test()
    Dim answer As Date
    On Error Resume Next
        Do
        answer = InputBox("please write down the right answer")
        If Err.Number <> 0 Then
            GoTo 100
        End If
        If answer = [a1] Then
            MsgBox "the answer is right"
            GoTo 101
        Else
            MsgBox "the answer is wrong"
        End If
100:
        Err.Clear
    Loop
101:
    Range("b1") = "jump out"
End Sub

image.png

Sub test()
    Dim countNum As Byte, rowsCount As Byte
    rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
    Do While countNum <> 3
        n = n + 1
        If n > rowsCount Then
            countNum = 3
        End If
        If Cells(n, "b") = 100 Then
            Cells(n, "b").Interior.ColorIndex = 3
            countNum = countNum + 1
        End If
    Loop
End Sub

image.png

Sub test()
    Dim countNum As Byte, rowsCount As Byte
    rowsCount = Cells(Rows.Count, 1).End(xlUp).Row
    Do Until countNum = 3
        n = n + 1
        If n > rowsCount Then
            countNum = 3
        End If
        If Cells(n, "b") = 100 Then
            Cells(n, "b").Interior.ColorIndex = 3
            countNum = countNum + 1
        End If
    Loop
End Sub

vba使用工作表函數(shù)：

image.png

Sub test()
    [d2] = Application.WorksheetFunction.AverageIf([b:b], "nv", [c:c])
    [d1] = WorksheetFunction.CountIfs([b:b], "nv", [c:c], ">60")
End Sub

vba隨機函數(shù)：

image.png

排序：

image.png

Sub test()
    Dim cr As Range
    Set cr = Range("a1").currentRegion
    cr.Sort Range("b1"), xlAscending, Range("c1"), , xlDescending, Header:=xlYes
End Sub

find查詢：

image.png

Sub test()
    [d1] = Range("a:a").Find("tianqi", , xlValues, xlWhole, , xlNext).Address(0, 0)
End Sub

findnext查詢：

image.png

Sub test()
    Dim rng As Range
    Set rng = Range("a:A").Find("zhangsan")
    MsgBox Range("a:A").FindNext(rng).Row
End Sub

篩選：

image.png

Sub test()
    Range("a1").AutoFilter 2, ">2", xlAnd, "<800"
End Sub

拆分工作簿：

image.png

Sub test()
    Dim wb As Workbook, w1 As Workbook
    Set w1 = ThisWorkbook
    Set wb = Workbooks.Add
    w1.Sheets(1).Range("a1:a9").Copy wb.Sheets(1).Range("a1")
    wb.SaveAs ThisWorkbook.Path & "/" & "123.xls"
End Sub

UNION并集：

image.png

Sub test()
    Dim rng As Range
    Set rng = Union(Range("a2"), Range("c2"))
    rng.Select
End Sub

交集：

image.png

Sub test()
    Dim rng As Range
    Set rng = Intersect(Range("a1").Resize(4, 4), Range("b1").Resize(7, 2))
    rng.Select
End Sub

定位：

image.png

Sub test()
    Dim rng As Range, ss As Range
    Set rng = Range("a1").CurrentRegion.SpecialCells(xlCellTypeBlanks)
    For Each ss In rng
        ss.Value = "test value"
    Next
End Sub

AutoFill自動填充：

image.png

Sub test()
    Range("e2").AutoFill Range("e2:e8")
End Sub

replace替換：

image.png

Sub test()
    Range("a1").CurrentRegion.Replace what:="test value", replacement:="new valuesss "
End Sub

with語句：

image.png

Sub test()
    With ThisWorkbook.Sheets(1)
        .Range("e1") = 1
        .Range("e2") = 2
        .Range("e3") = 3
    End With
End Sub

DIR函數(shù)：

image.png

Sub test()
    Dim fileName$
    fileName = Dir("/Users/luowei/Downloads/")
    Do
        n = n + 1
        Cells(n, "f").Value = fileName
        fileName = Dir
    Loop Until fileName = ""
End Sub

超鏈接：

image.png

Sub test()
    Sheet1.Hyperlinks.Add Range("e1"), "/Users/luowei/Downloads/計算機組成原理.pdf", "a1", "ti shi", "xianshi"
End Sub

合并單元格：

image.png

instr函數(shù)：

image.png

Sub test()
    MsgBox InStr(Range("f4"), ".")
End Sub

like運算符：

image.png

Sub test()
    MsgBox "12" Like "?2"
End Sub

name語句：

image.png

Sub test()
    Name "/Users/luowei/Downloads/tt.xlsx" As "/Users/luowei/Downloads/test.xlsx"
End Sub

不同單元格填充不同顏色：

image.png

批量移動文件:

image.png

mkdir：

image.png

Sub test()
    MkDir ThisWorkbook.Path & "/tset"
End Sub

數(shù)組寫入和讀取

image.png

Sub test()
'    arr = Array(1, 2, 3)
'    Range("a1:c1") = arr
'    arr = Range("a1:a3")
'    Range("b1:b3") = arr
'arr = Range("a1:a3")
'Range("a1:c1") = WorksheetFunction.Transpose(arr)
arr = Range("a1").CurrentRegion
Range("a5:c10") = WorksheetFunction.Transpose(arr)
End Sub

for循環(huán)遍歷數(shù)組

image.png

Sub test()
arr = Range("a1").CurrentRegion
    For i = 2 To 4
        Cells(i + 5, 1) = arr(i, 1)
        For j = 2 To 3
            totalResult = totalResult + arr(i, j)
        Next
        Cells(i + 5, 2) = totalResult
        totalResult = 0
    Next
End Sub

數(shù)組的聲明

image.png

Sub test()
    '生成一維數(shù)組，數(shù)組下標從0開始
'    Dim arr(4)
'as integer指定數(shù)組的類型為數(shù)值類型
'    Dim arr(3) As Integer
    '生成一維數(shù)組，數(shù)組下標從1開始
'    Dim arr(1 To 3)
    '聲明二維數(shù)組
    Dim arr(1 To 3, 1 To 2)
End Sub

動態(tài)數(shù)組

image.png

Sub test()
    Dim arr(), brr()
    arr = Range("a7").CurrentRegion
    For i = 1 To 4
        If arr(i, 1) = Range("d7").Value Then
            n = n + 1
            'redim重新定義數(shù)組大小，preserve重新定義數(shù)組大小時，不清除以前的值
            ReDim Preserve brr(n)
            brr(n) = arr(i, 2)
        End If
    Next i
    MsgBox WorksheetFunction.Sum(brr)
End Sub

聲明數(shù)組時使用變量，使用redim聲明數(shù)組

Sub test()
   i = 1 + 1
   '如果聲明數(shù)組時，使用了變量，那么定義數(shù)組應(yīng)該使用redim關(guān)鍵字
   ReDim arr(1 To i)
End Sub

數(shù)組的ubound

image.png

Sub test()
   Dim arr(1 To 3, 2 To 5)
   '返回數(shù)組一維的上標
   MsgBox UBound(arr, 1)
   '返回數(shù)組二維的上標
   MsgBox UBound(arr, 2)
    '返回數(shù)組二維的下標
   MsgBox LBound(arr, 2)
End Sub

image.png

Sub test()
   Dim arr(), brr(1 To 40, 1 To 3)
   arr = Range("a1").CurrentRegion
   For i = 2 To UBound(arr)
        For j = 2 To UBound(arr, 2)
            n = n + 1
            brr(n, 1) = arr(i, 1)
            brr(n, 2) = arr(1, j)
            brr(n, 3) = arr(i, j)
        Next
   Next
   Range("e2").Resize(UBound(brr), 3) = brr
End Sub

利用數(shù)組進行冒泡排序

Sub test()
   arr = [a10:d10]
   arr = WorksheetFunction.Transpose(WorksheetFunction.Transpose(arr))
   For i = 1 To UBound(arr) - 1
        For j = 1 To UBound(arr) - i
            If arr(j) > arr(j + 1) Then
                temp = arr(j + 1)
                arr(j + 1) = arr(j)
                arr(j) = temp
            End If
        Next
   Next
   Range("a11").Resize(1, 4) = arr
End Sub

拆分函數(shù)split

image.png

Sub test()
   Dim str As String
   str = "zhang,li,zhao"
   arr = Split(str, ",")
   For i = LBound(arr) To UBound(arr)
    MsgBox arr(i)
   Next
End Sub

join函數(shù)

image.png

Sub test()
   Dim arr()
   arr = Array(1, 2, 3)
   MsgBox Join(arr, "-")
End Sub

篩選函數(shù)filter

image.png

Sub test()
   arr = Array(12, 142, 43)
   brr = Filter(arr, "1")
   MsgBox Join(brr, "-")
End Sub

工作表函數(shù)

image.png

Sub test()
    arr = [a1].CurrentRegion
    brr = WorksheetFunction.Index(arr, 0, 1)
    brr = WorksheetFunction.Transpose(brr)
    r = WorksheetFunction.Match([e1], brr, 0)
    Range("d2:e2") = WorksheetFunction.Index(arr, r, 0)
End Sub

數(shù)組去除空值

image.png

Sub test()
    arr = WorksheetFunction.Transpose(Range("a1:a10"))
    t = Join(arr)
    t = WorksheetFunction.Trim(t)
    arr = Split(t)
    Range("b1:b6") = WorksheetFunction.Transpose(arr)
End Sub

清空數(shù)組

Sub test()
    Dim arr()
    arr = Array("zhagn", "li")
    '使用erase刪除指定數(shù)組中的數(shù)據(jù)
    Erase arr
    MsgBox 1
End Sub

提取數(shù)組的唯一值

Sub test()
    On Error Resume Next
    Dim brr()
    arr = Range("a1:a11")
    ReDim brr(1 To UBound(arr))
    For i = LBound(arr) To UBound(arr)
  '判斷a數(shù)組中的項，在b數(shù)組中是否存在，如果不存在就放到b數(shù)組
        n = WorksheetFunction.Match(arr(i, 1), brr, 0)
        If n = "" Then
            j = j + 1
            brr(j) = arr(i, 1)
        End If
        n = ""
    Next
    MsgBox Join(brr)
End Sub

字典的add、keys、items方法

Sub test()
    Set dic = CreateObject("scripting.dictionary")
  '該方法添加條目到字典
    dic.Add "zhang", "san"
    dic.Add "li", "si"
'返回字典的所有條目
    arr = dic.items
    MsgBox arr(0)
'返回字典的所有鍵
    brr = dic.keys
    MsgBox brr(0）
End Sub

字典的exists、Remove、RemoveAll方法

Sub test()
    Set dic = CreateObject("Scripting.dictionary")
    dic("1") = 1
    '判斷是否存在對應(yīng)的鍵
    MsgBox dic.exists("1")
    '刪除對應(yīng)的鍵和值
    dic.Remove ("1")
    '刪除所有對鍵和值
    dic.RemoveAll
End Sub

字典的count、comparemode屬性

Sub test()
    Set dic = CreateObject("Scripting.dictionary")
    '設(shè)置字典的鍵是否區(qū)分大小寫，0為區(qū)分，1為不區(qū)分,必須在未填寫進值之前設(shè)置
    dic.comparemode = 1
    dic("1") = 1
    dic.Item("2") = 2
    dic.Key("2") = 3
    '返回字典中鍵的總數(shù)
    MsgBox dic.Count
End Sub

正則表達式

Sub test()
    Dim sj As Variant, ss As Variant
    '后期綁定
    Set reg = CreateObject("vbscript.regexp")
    With reg
        '設(shè)置全局搜索
        .Global = True
        '設(shè)置匹配模式
        .Pattern = "\d+"
        '執(zhí)行匹配
        Set sj = .Execute("我123")
        For Each ss In sj
            MsgBox ss
        Next
    End With
End Sub

正則表達式replace替換字符串

Sub test()
    Dim sj As Variant, ss As Variant
    '后期綁定
    Set reg = CreateObject("vbscript.regexp")
    With reg
        '設(shè)置全局搜索
        .Global = True
        '設(shè)置匹配模式
        .Pattern = "\d+"
        '執(zhí)行匹配
        Set sj = .Execute("我123")
        For Each ss In sj
            'Replace替換字符串
            MsgBox .Replace(ss, "**")
        Next
    End With
End Sub

正則表達式test方法

Sub test()
    Dim sj As Variant, ss As Variant
    '后期綁定
    Set reg = CreateObject("vbscript.regexp")
    With reg
        '設(shè)置全局搜索
        .Global = True
        '設(shè)置匹配模式
        .Pattern = "\d+"
        '執(zhí)行匹配
        If .test("d122") Then
            MsgBox "數(shù)據(jù)匹配正則表達式"
        End If
    End With
End Sub

設(shè)置指定字符串對應(yīng)字符的背景顏色

Sub test1()
    '設(shè)置指定字符串對應(yīng)字符的背景顏色
    [i7].Characters(2, 3).Font.Color = 255
End Sub

排除匹配

Sub test()
    Dim sj As Variant, ss As Variant
    '后期綁定
    Set reg = CreateObject("vbscript.regexp")
    With reg
        '設(shè)置全局搜索
        .Global = True
        '設(shè)置匹配模式：匹配不是數(shù)字的字符串,^符號代表取非操作
        .Pattern = "[^\d+]+"
        '執(zhí)行匹配
        Set sj = .Execute("cdasd212")
        For Each ss In sj
            MsgBox ss
        Next
    End With
End Sub

后向引用

Sub test()
    Dim sj As Variant, ss As Variant
    '后期綁定
    Set reg = CreateObject("vbscript.regexp")
    With reg
        '設(shè)置全局搜索
        .Global = True
        '\1代表后向引用前面第一個括號內(nèi)的內(nèi)容
        .Pattern = "(\d{3}).*\1"
        '執(zhí)行匹配
        MsgBox .test("123za12")
    End With
End Sub

貪婪與懶惰匹配

image.png

muiltiline多行模式

image.png

零寬斷言

image.png

匹配引號

image.png

自定義函數(shù)

image.png

自定義函數(shù)默認參數(shù)

image.png

事件

image.png

記錄工作表修改時間

image.png

表單組件-單選框

image.png

多個單選框放入框架中

image.png

表單組件-復(fù)選框

image.png

表單組件-復(fù)合框

image.png

表單組件-listview控件
工具欄加載list控件

image.png

關(guān)于附加組件后顯示“未知”，無法調(diào)用的問題。

image.png

解決方法是注冊MSCOMCTL.OCX

image.png

將excel中的數(shù)據(jù)顯示到listview中

image.png

'添加listview的表頭
Private Sub CommandButton1_Click()
    Dim i As Integer, columnNum As Integer
    With ListView1
        columnNum = Range("a1").End(xlToRight).Column
        For i = 1 To columnNum
            .ColumnHeaders.Add i, , Cells(1, i).Value, .Width / columnNum, lvwColumnLeft
        Next
        .Gridlines = True
        .FullRowSelect = True
        .View = lvwReport
    End With
End Sub
'添加listview的數(shù)據(jù)
Private Sub CommandButton2_Click()
    Dim i As Integer, j As Integer, rowNum As Integer, columnNum As Integer, listItem As listItem
    With ListView1
        columnNum = Range("a1").End(xlToRight).Column
        rowNum = Range("a1").End(xlDown).Row
        For i = 2 To rowNum
            '每一條數(shù)據(jù)為一個listItem
            Set listItem = .ListItems.Add()
            '每一條數(shù)據(jù)的第一列為Text
            listItem.Text = Cells(i, 1)
            For j = 2 To columnNum
            '每一條數(shù)據(jù)從第二列開始為SubItems
                listItem.SubItems(j - 1) = Cells(i, j)
            Next
        Next

    End With
End Sub

色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九欧美,1769亚洲,黄色成人av

excel vba學(xué)習(xí)

excel vba學(xué)習(xí)

相關(guān)閱讀更多精彩內(nèi)容

友情鏈接更多精彩內(nèi)容

色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九 欧美,1769亚洲,黄色成人av

excel vba學(xué)習(xí)

相關(guān)閱讀更多精彩內(nèi)容

友情鏈接更多精彩內(nèi)容

色偷偷精品伊人,欧洲久久精品,欧美综合婷婷骚逼,国产AV主播,国产最新探花在线,九色在线视频一区,伊人大交九欧美,1769亚洲,黄色成人av