comando común de VBA

 

Copiar área de celdas, después de cerrar la tabla

 

Sub QS1DataCopy ()
 Dim c Como Rango
 ' copiar el Excel descargado para apuntar excel 
Con ActiveWorkbook.Worksheets ( 1 ) 
    máxFila = .Cells ( 100 , 1 ) .End (xlUp) .Row 
    maxRow2 = libros ( " reclamo del cliente order.xlsx " ) .Worksheets ( " status " ) .Cells ( 1048576 , 1 ) .End (xlUp) .Row 
    .Range (.Cells ( 2 , 3 ), .Cells (máxFila, 9 )). copiar libros ( "order.xlsx cliente reclamo " ) .Worksheets ( " status " ) .Cells (maxRow2 + 1 , 1 )
 End  Con 
Con libros ( " cliente reclamo order.xlsx " ) .Worksheets ( " Orden " )
 '     Set c = .Range ( .Cells (2, 1), .Cells (1000, 1)). Encontrar (libros de Trabajo ( "cliente reclamo order.xlsx"). Hojas de trabajo ( "Sheet1"). Las células (maxRow2, 8)) 
'     si no es c no es nada entonces 
'        Libros de trabajo ( "reivindicación cliente order.xlsx"). Las hojas de trabajo ( "Sheet1"). Rango (libros de trabajo ( "cliente reivindicación order.xlsx"). Las hojas de trabajo ( "Sheet1"). Las células (maxRow2 + 1, 8), libros de trabajo (" cliente reivindicación order.xlsx ") Hojas de trabajo (". Sheet1" ) células (maxRow2 + máxFila -. 1, 8)) = .Cells (c.Row + 1, 1) 
'     End If 
    Call closeworkbook
 End  Con 
libros de trabajo ( " reivindicación cliente order.xlsx " ) .Activate 
libros de trabajo ( " reivindicación cliente order.xlsx " ) .Worksheets ( " status " ) .Cells (maxRow2 + máxFila - 1 , 8 ).
Seleccione End Sub 
Sub closeworkbook ()
Dim wb Como libro de trabajo
 para  cada wb En Cuadernos
     Si wb.Name <> " reclamo del cliente order.xlsx "  Y wb.Name <> " PERSONAL.xlsm "  Entonces 
        SaveChanges wb.Close: = False 
    End  Si 
Siguiente 
End Sub 


表格隐藏,显示

ActiveWorkbook.Worksheets ( " Resumen ") .Visible = xlSheetVeryHidden  ActiveWorkbook.Worksheets ( " 1050-juez ") .Visible = xlSheetVisible

La determinación de si un punto en un rectángulo que

Función judgeInRange (x1 como gama, y1 como gama, x2 como gama, y2 como gama, x3 como gama, y3 como gama, x4 como gama, y4 como gama, x0 como gama, y0 como gama) Como Boole ' juzgar si el punto (x0, y0) está en el área combinada por el rectángulo (de point1 4 puntos izquierda superior punto de las agujas del reloj (x1, y1) punto2 (x2, y2) POINT3 (x3, y3) PUNTO4 (x4, y4)) a1 = x1. valor 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 Si judgeInScope (a1, a4, temx1) Entonces Si judgeInScope (A2, A3, temx2) Entonces Si judgeInScope (temx1, temx2, a0) Entonces judgeInRange = Verdadero Else judgeInRange = False End Si ElseIf judgeInScope (A4, A3, temx4) Entonces Si judgeInScope (temx1, temx4, a0) Entonces judgeInRange =Es cierto Else judgeInRange = False End Si ElseIf judgeInScope (a2, a1, temx3) Entonces Si judgeInScope (temx1, temx3, a0) Entonces judgeInRange = verdadero Else judgeInRange = False End Si Else judgeInRange = False End Si Else Si judgeInScope (A4, A3, temx4) Entonces Si judgeInScope (temx2, temx4, a0) Entonces judgeInRange = Verdadero Else judgeInRange = False End Si ElseIf judgeInScope (a2, a1, temx3) A continuación,Si judgeInScope (temx2, temx3, a0) Entonces judgeInRange = Verdadero Else judgeInRange = False End Si Else judgeInRange = False End Si Fin Si Función del final judgeInScope Función (a1, b1, x1) Como Boole ' juzgar si x1 es entre A1 y B1 si A1> = b1 Entonces Si x1> = b1 Y x1 <= a1 Entonces judgeInScope = Verdadero Else judgeInScope = False End Si Else Si x1> = a1 Y x1 <= b1 EntoncesjudgeInScope = Verdadero Else judgeInScope = False End Si Fin Si End Function

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

Función findPosition (FINDTEXT como secuencia, withinText como secuencia, startPosición As Long, textCount como de largo) 
'encontrar la posición de FINDTEXT en el withinText; 
'startPosición es la posición de inicio en el withinText 
' textCount es el recuento de FINDTEXT desea encontrar, si no, entonces devolver 0 
'Si textCount <= 0, entonces encontrar el último de los FINDTEXT en el withinText 
findPosition = 0 
Si Len ( WorksheetFunction.Substitute (withinText, FINDTEXT, "")) = Len (withinText) Luego 
    Exit Function 
End If 
Si textCount> 0, entonces 
    para i = 1 Para textCount 
        Si startPosición> Len (withinText) Entonces 
            findPosition = 0 
            Salir Para
        ElseIf EsError (WorksheetFunction.Find (FindText, withinText, startPosición)) Entonces 
            findPosition = 0 
            Exit Para 
        ElseIf i = textCount Entonces 
            findPosition = WorksheetFunction.Find (FindText, withinText, startPosición) 
        Else 
            startPosición = WorksheetFunction.Find (FindText, withinText, startPosición) + 1 
        End If 
    Siguiente 
Else 'encontrar la última 
    hace mientras que startPosición <= Len (withinText) 
        Si EsError (WorksheetFunction.Find (FINDTEXT, withinText, startPosición)) Entonces 
            Salir Do 
        Else 
            findPosition = WorksheetFunction.Find (FINDTEXT, withinText, startPosición)
            startPosición = findPostion + 1 
        End If 
    Loop 
End If 
'Debug.Print findPostion 
End Function