VBA练习笔记_BOM

目录

两列对比

根据Item补全

高级筛选

计算数目

从表格创建字典

删除第一个字符

---

---

Cells与Range的参数基本用法

获取最大行数

引号字符：chr(34)

Sub AllegroBOM格式transform()
Dim LastRow&    'Long
Dim i&
ActiveSheet.Select
LastRow = Range("A65536").End(xlUp).Row '注意是A列的最大行数
'MsgBox ("最大行数:" & LastRow)

'表头赋值
'Cells(E, 1) = "Layer"  '报错之为何？ 当为(1,"E")
'Range("D"1).Value = "Chr(34)"  '此处Range指定单元格 格式错误，直接引用于参数传递引用不同
Range("D1") = Chr(34) & "{Reference}" & Chr(34)
Range("E1") = Chr(34) & "Layer" & Chr(34)

For i = 2 To LastRow
    Range("d" & i) = Chr(34) & Range("a" & i) & Chr(34)
    'Cells(E, i) = Cells(B, i) & Chr(34) '使用Cells报错
    If (Range("b" & i).Value = "YES") Then
       Range("e" & i) = Chr(34) & "BOT" & Chr(34)
    ElseIf (Range("b" & i).Value = "NO") Then
       Range("e" & i) = Chr(34) & "TOP" & Chr(34)
    End If
Next
End Sub

---

两列对比

Sub 比对JK()
    Dim LastRow&    'Long
    Dim i&
    ActiveSheet.Select
    LastRow = Range("J65536").End(xlUp).Row '注意是J列的最大行数
    For i = 2 To LastRow
        If (Range("J" & i) <> Range("K" & i)) Then '<> 即 ！=
             Sheets(2).Range("L" & i) = "False" '文字提示
             Sheets(2).Range(("J" & i), ("L" & i)).Select '选中设置为红色字体
                With Selection.Font
                 .Color = -16776961
                .TintAndShade = 0
                End With
        End If
    Next
End Sub

根据Item补全

输入参数：InputBox

格式转换，然后判断

Sub 相同Item补全Reference()
    ActiveSheet.Select         '当前活动Sheet下的操作
    Dim col%            '获取选中单元格的列
    Dim rng As Range
    
    Set rng = Application.InputBox("请选择其中一个或多个单元格(为获取所在列)：", Type:=8)
    'Set rng = Application.InputBox("用鼠标点击要补全的其中一个单元格(例如: H1)：", "补全Reference", Type:=8)
    col = rng.Column
    'MsgBox ("所选列：" & col)   获取到的是数字
   
    Dim LastRow&    'Long
    Dim i&
    LastRow = Range("A65536").End(xlUp).Row '注意是A列的最大行数
    
    'A列进行格式转
    Range("A:A").Select
    Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

    For i = 2 To LastRow
        If (Range("a" & i).Value = Range("a" & i - 1).Value) Then
            Cells(i, col) = Cells(i - 1, col)
            'Range("col" & i) = Range("col" & i - 1)
        End If
    Next
End Sub

---

高级筛选

高级筛选的宏定义

清空剪贴板 Application.CutCopyMode = False 

Sub 筛选YES_NO()
    Columns("H:I").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "K1:K2"), CopyToRange:=Range("L1"), Unique:=False
    Application.CutCopyMode = False '清空剪贴板
    Columns("H:I").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "J1:J2"), CopyToRange:=Range("N1"), Unique:=False
End Sub

---

计算数目

利用Len()计算字符长度

Replace("原来","替换") 注意会改变所替换的格子，而不是单纯引用值

Sub 计算数目()
    '
    ActiveSheet.Select
    Dim i&
    Dim LastRow& 'long
    Dim Length_D%
    Dim str$
    
    LastRow = Range("D65536").End(xlUp).Row '注意是D列的最大行数
    'MsgBox (LastRow)
    For i = 2 To LastRow
    'Range("E" & i) = Len(Range("D") & i) 'len的参数是单元格
    Length_D = Len(Range("D" & i))
    'Length_D2 = Len(Range("D" & i).Replace(",", ""))
    Range("E" & i) = Range("D" & i)
    str = Range("E" & i).Replace(",", "") '赋值语句会改变Ei的值？？？
    Range("E" & i) = Length_D - Len(Range("E" & i)) + 1
          
    Next
End Sub

---

从表格创建字典

Sub 从表格创建字典()
    '
    Dim dic As Object
    Dim arr     '用于存储单元格数据
    
    Set dic = CreateObject("Scripting.Dictionary") '创建字典
    arr = Sheet6.[a1].CurrentRegion    '将Sheets6的 数据放入数组
    
    For i = 1 To UBound(arr)    '返回数组相应维度最大值，默认参数Ubound(arr,1)=最大行数
        dic(arr(i, 1)) = arr(i, 2)  '构建字典：dic(key_name)=item
    Next
    
    For i = 1 To Range("E65536").End(xlUp).Row      'E 列的最大值
        Cells(i, "f") = dic(Cells(i, "e").Value)    'e列作为key ,获取对应的item写入f
    Next
    
End Sub

删除第一个字符

Right函数

---

Sub del_第一个字符() '删除第一个字符
    '删除多余的字符：第一个","
    For i = 2 To [a65536].End(xlUp).Row    'a 列的最大值
        If Len(Range("e" & i)) > 0 Then
            Range("e" & i) = Right(Range("e" & i), Len(Range("e" & i)) - 1)
        End If
        If Len(Range("d" & i)) > 0 Then
            Range("d" & i) = Right(Range("d" & i), Len(Range("d" & i)) - 1)
        End If
    Next
End Sub