Common VBA command

Copy cell range, after closing table

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
closeworkbook ()
SubEnd Sub
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


Determining whether a point on a rectangle it

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

Guess you like