VBA额外栏搜寻

2024-05-04 • 问答

我需要在以下代码中添加PW，即RDG1，PW，下水道工程，通行证。额外的一栏将是D栏，加油。

With ThisWorkbook.Sheets(1)
    .Range("D5").Value = Counts("RDG1","Sewer Works")
    .Range("E5").Value = Counts("RDG1","Sewer Works","PASS")
    .Range("F5").Value = Counts("RDG1","FAIL")

    'other counts here

End With



'Get row counts from sheet2
'  Optional 3rd parameter for PASS/FAIL
Function Counts(v1 As String,v2 As String,Optional v3 As String = "") As Long
    Dim rng1 As Range,rng2 As Range,rng3 As Range
    With ThisWorkbook.Sheets(2)
        Set rng1 = .Range("C7:C10000")
        Set rng2 = .Range("G7:G10000")
        Set rng3 = .Range("I7:I10000")
        If Len(v3) > 0 Then
            Counts = Application.CountIfs(rng1,v1,rng2,v2,rng3,v3)
        Else
            Counts = Application.CountIfs(rng3,v2)
        End If
    End With
End Function

未经测试-您应该获得常规模式...

.PS
 move down;
 right;
 move right
 B: box "B"; move right
 C: box "C"; move right
 D: box "D"; move right
 E: box "E"; move right
 F: box "F"; move right
 b2cX=C.c.x-B.c.x

 move to C.e + (D.w-C.e)/2; move up 1

 A: box "A" outline "red"
 a2redlineY=A.s.y - D.n.y
 redDeltaYtop=a2redlineY * .5
 redDeltaYbottom=a2redlineY-redDeltaYtop
 blueDeltaYtop=a2redlineY * .75
 blueDeltaYbottom=a2redlineY-blueDeltaYtop

 down
 ############################################################
 # RED
 ############################################################
 # draw line down from  A to the (to be drawn) bus
 X: line down  redDeltaYtop from .25 <A.sw,A.se>  outline "red" 
 Ap: X.s
 line left to ((B.w.x+((B.e.x-B.w.x)*.3)),Here.y) outline "red" 

 line down redDeltaYbottom outline "red"      # down to B
 move up  redDeltaYbottom                     # back up

 line right b2cX   outline "red"              # line to C 
 X: line down redDeltaYbottom outline "red"   # line down
 Cp: X.n
 move up redDeltaYbottom                      # back up

 line right b2cX   outline "red"              # line to D 
 X: line down redDeltaYbottom outline "red"   # line down
 Dp: X.n
 move up  redDeltaYbottom                     # back up

 line right b2cX   outline "red"              # line to E 
 X: line down redDeltaYbottom outline "red"   # line down
 Ep: X.n
 move up  redDeltaYbottom                     # back up


 ### draw connection points
 circle diam .05 shaded "black" with .c at Ap
 circle diam .05 shaded "black" with .c at Cp
 circle diam .05 shaded "black" with .c at Dp

 ############################################################
 # blue
 ############################################################
 # draw line down from  A to the (to be drawn) bus
 X: line down  blueDeltaYtop from .75 <A.sw,A.se>  outline "blue" 
 Ap: X.s
 line left to ((C.e.x+((C.w.x-C.e.x)*.3)),Here.y) outline "blue" 

 line down blueDeltaYbottom outline "blue"      # down to C
 move up  blueDeltaYbottom                     # back up

 line right b2cX   outline "blue"              # line to D 
 X: line down blueDeltaYbottom outline "blue"   # line down
 Dp: X.n
 move up  blueDeltaYbottom                     # back up

 line right b2cX   outline "blue"              # line to E 
 X: line down blueDeltaYbottom outline "blue"   # line down
 Ep: X.n
 move up  blueDeltaYbottom                     # back up

 line right b2cX   outline "blue"              # line to F 
 X: line down blueDeltaYbottom outline "blue"   # line down
 Fp: X.n
 move up  blueDeltaYbottom                     # back up

 ### draw connection points
 circle diam .05 shaded "black" with .c at Ap
 circle diam .05 shaded "black" with .c at Dp
 circle diam .05 shaded "black" with .c at Ep
.PE

VBA额外栏搜寻

lisuge 回答：VBA额外栏搜寻

大家都在问