常用VBA 命令

单元格区域复制，后关闭表格

Sub QS1DataCopy()
Dim c As Range
'copy the downloaded excel to target excel
With ActiveWorkbook.Worksheets(1)
    maxRow = .Cells(100, 1).End(xlUp).Row
    maxRow2 = Workbooks("customer claim order.xlsx").Worksheets("status").Cells(1048576, 1).End(xlUp).Row
    .Range(.Cells(2, 3), .Cells(maxRow, 9)).Copy Workbooks("customer claim order.xlsx").Worksheets("status").Cells(maxRow2 + 1, 1)
End With
With Workbooks("customer claim order.xlsx").Worksheets("Order")
'    Set c = .Range(.Cells(2, 1), .Cells(1000, 1)).Find(Workbooks("customer claim order.xlsx").Worksheets("Sheet1").Cells(maxRow2, 8))
'    If Not c Is Nothing Then
'        Workbooks("customer claim order.xlsx").Worksheets("Sheet1").Range(Workbooks("customer claim order.xlsx").Worksheets("Sheet1").Cells(maxRow2 + 1, 8), Workbooks("customer claim order.xlsx").Worksheets("Sheet1").Cells(maxRow2 + maxRow - 1, 8)) = .Cells(c.Row + 1, 1)
'    End If
    Call closeworkbook
End With
Workbooks("customer claim order.xlsx").Activate
Workbooks("customer claim order.xlsx").Worksheets("status").Cells(maxRow2 + maxRow - 1, 8).Select
End Sub
Sub closeworkbook()
Dim wb As Workbook
For Each wb In Workbooks
    If wb.Name <> "customer claim order.xlsx" And wb.Name <> "PERSONAL.xlsm" Then
        wb.Close savechanges:=False
    End If
Next
End Sub


表格隐藏，显示

ActiveWorkbook.Worksheets("summary").Visible = xlSheetVeryHidden
ActiveWorkbook.Worksheets("1050-judge").Visible = xlSheetVisible

判断一个点是否在一个矩形范围呢

Function judgeInRange(x1 As Range, y1 As Range, x2 As Range, y2 As Range, x3 As Range, y3 As Range, x4 As Range, y4 As Range, x0 As Range, y0 As Range) As Boolean
' judge whether the point(x0,y0) is in the area combined by rectangle ( from left-upper point clockwise 4 points point1(x1,y1) point2 (x2,y2) point3(x3,y3) point4(x4,y4))
a1 = x1.Value
a2 = x2.Value
a3 = x3.Value
a4 = x4.Value
a0 = x0.Value
b1 = y1.Value
b2 = y2.Value
b3 = y3.Value
b4 = y4.Value
b0 = y0.Value

c1 = (a4 - a1) / (b4 - b1)
c2 = (a3 - a2) / (b3 - b2)
r1 = (a2 - a1) / (b2 - b1)
r2 = (a3 - a4) / (b3 - b4)
temx1 = c1 * b0 + a1 - b1 * c1
temx2 = c2 * b0 + a2 - b2 * c2
temx3 = r1 * b0 + a1 - b1 * r1
temx4 = r2 * b0 + a4 - b4 * r2
Debug.Print a1, a4, b1, b4, temx1, b0
If judgeInScope(a1, a4, temx1) Then
    If judgeInScope(a2, a3, temx2) Then
        If judgeInScope(temx1, temx2, a0) Then
            judgeInRange = True
        Else
            judgeInRange = False
        End If
    ElseIf judgeInScope(a4, a3, temx4) Then
        If judgeInScope(temx1, temx4, a0) Then
            judgeInRange = True
        Else
            judgeInRange = False
        End If
    ElseIf judgeInScope(a2, a1, temx3) Then
        If judgeInScope(temx1, temx3, a0) Then
            judgeInRange = True
        Else
            judgeInRange = False
        End If
    Else
        judgeInRange = False
    End If
Else
    If judgeInScope(a4, a3, temx4) Then
        If judgeInScope(temx2, temx4, a0) Then
            judgeInRange = True
        Else
            judgeInRange = False
        End If
    ElseIf judgeInScope(a2, a1, temx3) Then
        If judgeInScope(temx2, temx3, a0) Then
            judgeInRange = True
        Else
            judgeInRange = False
        End If
    Else
        judgeInRange = False
    End If
End If
End Function
Function judgeInScope(a1, b1, x1) As Boolean
'judge whether x1 is between a1 and b1
If a1 >= b1 Then
    If x1 >= b1 And x1 <= a1 Then
        judgeInScope = True
    Else
        judgeInScope = False
    End If
Else
    If x1 >= a1 And x1 <= b1 Then
        judgeInScope = True
    Else
        judgeInScope = False
    End If
End If

End Function

查找一个字符串在另一个字符串中的位置

Function findPosition(findText As String, withinText As String, startPosition As Long, textCount As Long)
'find the position of findText in the withinText;
'startPosition is the start position in the withinText
'textCount is the count of findText you want to find, if no then return 0
'If textCount<=0, then find the last one of the findText in the withinText
findPosition = 0
If Len(WorksheetFunction.Substitute(withinText, findText, "")) = Len(withinText) Then
    Exit Function
End If
If textCount > 0 Then
    For i = 1 To textCount
        If startPosition > Len(withinText) Then
            findPosition = 0
            Exit For
        ElseIf IsError(WorksheetFunction.Find(findText, withinText, startPosition)) Then
            findPosition = 0
            Exit For
        ElseIf i = textCount Then
            findPosition = WorksheetFunction.Find(findText, withinText, startPosition)
        Else
            startPosition = WorksheetFunction.Find(findText, withinText, startPosition) + 1
        End If
    Next
Else 'find the last one
    Do While startPosition <= Len(withinText)
        If IsError(WorksheetFunction.Find(findText, withinText, startPosition)) Then
            Exit Do
        Else
            findPosition = WorksheetFunction.Find(findText, withinText, startPosition)
            startPosition = findPostion + 1
        End If
    Loop
End If
'Debug.Print findPostion
End Function