Question

我有2本工作簿。 1用作查找，1用作原始数据。这两个工作簿中都有CA代码（员工代码）。但是，CA代码不属于同一部门，并且在查找工作簿中列出。

我需要我的宏能够

检查Rawdata工作簿中是否存在CA代码
检查部门
如果部门是“BIB”，则继续

如下所示，它目前只查找特定的CA代码，这意味着我必须在查找和代码中更新该值。

我还没有试图让它去寻找“BIB”，因为我不知道我会怎么做。

查找数据在单元格中如下所示：

CA-code |组织。级别|名称|系

ca00813 | 530040 |员工员工| BIB

BIB可能是其他部门。

请注意，如果CA代码是BIB员工，这是一个称为中间操作的子操作，用于验证开放时间

Sub PS_Open() Dim LastRow4 As Long Application.Calculation = xlCalculationAutomatic Sheets("TempRaw").Activate LastRow4 = Range("C" & Rows.Count).End(xlUp).Row

Range("J2").Formula = "=Weekday(D2)"

Range("J2").AutoFill Destination:=Range("J2:J" & LastRow4)

Range("K2").FormulaLocal = "=INDEKS(Opslag_ugedage!$B$1:$B$7;SAMMENLIGN(J2;Opslag_ugedage!$A$1:$A$7;0))" Range("K2").AutoFill Destination:=Range("K2:K" & LastRow4)

Range("L2").FormulaLocal = "=TIME(D2)" Range("L2").AutoFill Destination:=Range("L2:L" & LastRow4)


 Dim rng As Range, rng2 As Range, x As Long  Dim Man As Integer, Tirs As Integer, Ons As Integer, Tors As Integer, Fre As Integer, Lør As Integer, Søn As Integer, IÅ As Integer
    Set rng = Range(Range("K2"), Range("K" & Rows.Count).End(xlUp))
    Set rng2 = Range(Range("L2"), Range("L" & Rows.Count).End(xlUp)) UÅ = 0 IÅ = 0 i = 0
    For x = rng.Cells.Count To 1 Step -1
        With rng.Cells(x)  **' IF it's a BIB employee If** rng.Cells(x).Offset(0, -6).Value = "ca00813" Or rng.Cells(x).Offset(0,
-6).Value = "ca00815" Or rng.Cells(x).Offset(0, -6).Value = "ca00818" _ Or rng.Cells(x).Offset(0, -6).Value = "ca6b101" Or rng.Cells(x).Offset(0, -6).Value = "ca6b60" Or rng.Cells(x).Offset(0,
-6).Value = "ca6b61" _ Or rng.Cells(x).Offset(0, -6).Value = "ca6b87" Or rng.Cells(x).Offset(0, -6).Value = "ca6b92" Or rng.Cells(x).Offset(0, -6).Value = "ca6b95" _ Or rng.Cells(x).Offset(0, -6).Value = "ca6b97" Or rng.Cells(x).Offset(0,
-6).Value = "ca6svs7" Or rng.Cells(x).Offset(0, -6).Value = "ca00816" _ Or rng.Cells(x).Offset(0, -6).Value = "ca01404" Or rng.Cells(x).Offset(0, -6).Value = "ca014041" Or rng.Cells(x).Offset(0, -6).Value = "ca6b63" _ Or rng.Cells(x).Offset(0, -6).Value = "ca00781" Or rng.Cells(x).Offset(0,
-6).Value = "ca00783" Or rng.Cells(x).Offset(0, -6).Value = "ca00785" _ Or rng.Cells(x).Offset(0, -6).Value = "ca00787" Or rng.Cells(x).Offset(0, -6).Value = "ca00789" Or rng.Cells(x).Offset(0,
-6).Value = "ca00790" _ Or rng.Cells(x).Offset(0, -6).Value = "ca00821" Or rng.Cells(x).Offset(0, -6).Value = "ca00928" Or rng.Cells(x).Offset(0, -6).Value = "ca00999" _ Or rng.Cells(x).Offset(0, -6).Value = "ca01083" Or rng.Cells(x).Offset(0,
-6).Value = "ca01267" Or rng.Cells(x).Offset(0, -6).Value = "ca01312" _ Or rng.Cells(x).Offset(0, -6).Value = "ca01313" Or rng.Cells(x).Offset(0, -6).Value = "ca01361" Or rng.Cells(x).Offset(0,
-6).Value = "ca01363" _ Or rng.Cells(x).Offset(0, -6).Value = "ca01364" Or rng.Cells(x).Offset(0, -6).Value = "ca00795" Or rng.Cells(x).Offset(0, -6).Value = "ca1f601" Then

    ' Så mål om det er indenfor åbningstiden i BSC og tæl antal UÅ (UdenforÅbningstid)


            If .Value = "Mandag" Then
                    If rng.Cells(x).Offset(0, 1) < 17 And rng.Cells(x).Offset(0, 1) >= 9 Then IÅ = IÅ + 1 Else UÅ = UÅ + 1
                    End If
            If .Value = "Tirsdag" Then
                    If rng.Cells(x).Offset(0, 1) < 13 And rng.Cells(x).Offset(0, 1) >= 9 Then IÅ = IÅ + 1 Else UÅ = UÅ + 1
                    End If
            If .Value = "Onsdag" Then
                    If rng.Cells(x).Offset(0, 1) < 13 And rng.Cells(x).Offset(0, 1) >= 9 Then IÅ = IÅ + 1 Else UÅ = UÅ + 1
                    End If
            If .Value = "Torsdag" Then
                    If rng.Cells(x).Offset(0, 1) < 17 And rng.Cells(x).Offset(0, 1) >= 9 Then IÅ = IÅ + 1 Else UÅ = UÅ + 1
                    End If
            If .Value = "Fredag" Then
                    If rng.Cells(x).Offset(0, 1) < 13 And rng.Cells(x).Offset(0, 1) >= 9 Then IÅ = IÅ + 1 Else UÅ = UÅ + 1
                    End If
            If .Value = "Lørdag" Or .Value = "Søndag" Then UÅ = UÅ + 1

        Else
        ' Ellers (Hvis det ikke er BIB medarbejder), så tæl IÅ (Indenfor Åbningstid)
            IÅ = IÅ + 1
            ' IÅ = IÅ + 1 Fre = Fre + 1 'And cell.Offset(0, 6).Value = "Mandag"
            'If Weekday = vbFriday Then Fre = Fre + 1 'And cell.Offset(0, 6).Value = "Mandag"

            End If
        End With
    i = i + 1
    Next x

Sheets("Ark1").Range("N13").Value = UÅ
    'MsgBox "Inden for åbningstid: " & IÅ & "   Udenfor åbningstid: " & UÅ


Application.Calculation = xlCalculationManual

'Slet TempRaw efter validering af tal ActiveWorkbook.Worksheets("TempRaw").Activate Application.DisplayAlerts = False ActiveSheet.Delete Application.DisplayAlerts = True

End Sub

Answer 1

public function check_dep(CA_code as variant,dep as varaint) as boolean
val1=CA_code
lr=workbook("Rawdata").sheets(1).range("A"& rows.count).end(xlup).row
for i=2 to lr
val2=workbook("Rawdata").sheets(1).cells(i,1).value
if val==val2 then
dep1=workbook("Rawdata").sheets(1).cells(i,4).value
if dep1=dep then
check_dep=True
else
check_dep=False
end if
end if
next i
return checK_dep
end function

您可以使用此功能检查CA代码是否属于您可以在if条件中使用它所需的部门

if check_dep("ca00813","BiB") then
'statements to be executed
end if

如果需要检查一系列ca_codes，请使用：

Dim cell as range
Dim ca_rng as range
Lr2= workbooks("Main workbook").Sheets(1). range("A"& rows.count).end(xlup).row
Set ca_rng= workbooks("Main workbook").Sheets(1). range("A2:A" & lr2)
For each cell in ca_rng
Ca_code= cell.vlaue
 IF Check_dep(ca_code,"BIB") then
 ' statements
 End if
 Next

比较2个单元格，然后读取第3个

1 个答案: