Question

我有一个按钮的功能，一旦我点击它就被激活，它显示数据行（具有特定条件，因此它不会给所有行返回）来自一个名为的新工作表中的两个相同的工作表（ Issue_SumofShares）。问题在于交叉检查时，由于比较了第一张表（NBG_RegionaData）中的所有行和第二张表中的第一行（NBG_ComparisonRegionData），因此重复了很多数据行，然后转到第二行第二张表，然后继续。我知道我可以手动或通过＆＃34;删除重复项＆＃34;删除重复项（删除第一列和第二列中具有相同值的行）。按钮，但我想在显示结果之前按下按钮时自动删除重复项，所以我添加了DeleteRows子，并尝试调用它，但它不起作用，所以有人可以告诉我哪里出错了或告诉我如何自动重复删除它是在按下其按钮后打开工作表（Issue_SumofShares）之前自动发生的。这是我的代码：

' A function which shows all the same projects with sum of shares <> 1

Function VerifySumofShares() As Integer
Application.ScreenUpdating = False
Application.Calculation = xlManual

'Get the number of rows in NBG_Data_Comparison_Region
MAX_Row = Sheets(NBG_ComparisonRegionDataWorksheetName).UsedRange.Rows.Count
'Get the number of rows in NBG_Data_Region
MAX_Row1 = Sheets(NBG_RegionaDataWorksheetName).UsedRange.Rows.Count

' having names for each comparing part to make the if statment easier
Dim NBGMonth As String
Dim NBGYear As String
Dim NBGCarmaker As String
Dim NBGProject As String
Dim NBGFamily As String
Dim NBGStatus As String
Dim NBGShare As Integer
Dim NBGCst As String
Dim CompMonth As String
Dim CompYear As String
Dim CompCarmaker As String
Dim CompProject As String
Dim CompFamily As String
Dim CompStatus As String
Dim CompShare As Integer
Dim CompCst As String
Dim RNumber As Integer



'Count the Sum of shares for same projects which <> 1

Issue_SumofSharesCnt = 0
Issue_SumofSharesWorksheetName = "Issue_SumofShares"
' Clear Issue Som of Shares Data Sheet

Worksheets(Issue_SumofSharesWorksheetName).Cells.Clear

' Customize Issue_SumofShares sheet

Worksheets(Issue_SumofSharesWorksheetName).Cells(1, 1) = "Report of projects with multiple customers and Sum of Shares that does not equal 100%"

With Worksheets(Issue_SumofSharesWorksheetName).Cells(1, 1).Font
    .Bold = True
    .Size = 14
    .color = RGB(255, 0, 0)
End With

SOP = "C"
Status = "AD"
Customer = "A"
Product = "B"
Responsible = "AT"
Family = "AA"
Project = "AB"
carmaker = "AJ"
Share = "BQ"
GeoRegion = "BF"

With Worksheets(Issue_SumofSharesWorksheetName)
    .Range("A2") = "Data Row"
    .Range("F2") = "Project"
    .Range("C2") = "SOP (dd-Month-yy QQ)"
    .Range("D2") = "Product"
    .Range("I2") = "Responsible"
    .Range("E2") = "Family"
    .Range("G2") = "Carmaker"
    .Range("H2") = "Share"
    .Range("B2") = "Customer"
    .Range("J2") = "Region"
    .Range("K2") = "Status"
    .Range("A2:Z2").Font.Bold = True
End With

' Take the data of the NBG_Data_Comparison_Region
For Row = 2 To MAX_Row


     'CompMonth = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, SOP).Value
     'CompMonth = DatePart("m", CompMonth)

     CompYear = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, SOP).Value
     CompYear = DatePart("yyyy", CompYear)

     CompCarmaker = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, carmaker).Value
     CompProject = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, Project).Value
     CompFamily = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, Family).Value
     CompStatus = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, Status).Value
     CompShare = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, Share).Value
     CompCst = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, "A").Value

     ' Take the data from NBG_Data_Region sheet to be compared with each row of the NBG_Data_Comparison_Region sheet

    For Row1 = 2 To MAX_Row1


    If Row1 >= MAX_Row1 Then
      Exit For
    End If


    'NBGMonth = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, SOP).Value
    'NBGMonth = DatePart("m", NBGMonth)

    NBGYear = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, SOP).Value
    NBGYear = DatePart("yyyy", NBGYear)

    NBGCarmaker = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, carmaker).Value
    NBGProject = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Project).Value
    NBGFamily = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Family).Value
    NBGStatus = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Status).Value
    NBGShare = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Share).Value
    NBGCst = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, "A").Value









  ' StatusBar Show

   Application.StatusBar = "VerifySumofShares. Progress: " & Row & " of " & MAX_Row

       'Check if any row with a SOP date in the previous or current years and if it is a D-IN or OPP is found and add it to the IssueSOP_Date sheet

       ' NAF 20161208
       'Test with comparison of YEAR and MONTH
       ' If (NBGMonth = CompMonth And NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then
       ' With Year only
        If (NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then

            'Customization of the Issue_SumofShares sheet to show the NBG Data Row , Cst, SOP , Product, Responsible,Family , Carmaker , Share , Status and the GeoRegion of the data which the condition applies to
            'NBGStatus <> "LOST" And CompStatus <> "LOST" And
            'And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <= 0.99 And CompShare + NBGShare > 1

            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "A").Value = Row1
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "B").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Customer).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "C").Value = GetMonthAndQuarter(Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, SOP).Value)
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "D").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Product).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "E").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Family).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "F").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Project).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "G").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, carmaker).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "H").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Share).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "I").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Responsible).Value
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "K").Value = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, Status).Value
            ' Region As String
            Region = ""

            'Add any other GeoRegion which is also responsible in the recorded data


            If Worksheets(NBG_DataWorksheetName).Cells(Row1, "BC") Then
            Region = Region + "@EMEA"
            End If

            If Worksheets(NBG_DataWorksheetName).Cells(Row1, "BD") Then
            Region = Region + "@AMERICAS"
            End If

            If Worksheets(NBG_DataWorksheetName).Cells(Row1, "BE") Then
            Region = Region + "@GCSA"
            End If

            If Worksheets(NBG_DataWorksheetName).Cells(Row1, "BF") Then
            Region = Region + "@JAPAN&KOREA"
            End If
            Worksheets(Issue_SumofSharesWorksheetName).Cells(3 + Issue_SumofSharesCnt, "J").Value = Region





            'Count the number of the cases recorded

            Issue_SumofSharesCnt = Issue_SumofSharesCnt + 1

            'If there is no items , the Message to show

        ElseIf (Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, SOP).Value = "There are no items to show in this view.") Then

     End If

         Call DeleteRows

     Next Row1

     Next Row



' Send the Counter to show on the Menu sheet on the button involved

VerifySumofShares = Issue_SumofSharesCnt



    Application.ScreenUpdating = True
    Application.Calculation = xlAutomatic


  End Function




 Sub DeleteRows()
  Dim Rng As Range


With Issue_SumofSharesWorksheetName
    Set Rng = Range("A1", Range("B1").End(xlDown))
    Rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes
End With

End Sub

Answer 1

您可能需要为您的工作表名称修改它。我测试了它，效果很好。

Sub DeleteRows()

Dim Rng As Range, LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set Rng = Range("A1", Range("B" & LastRow))
Rng.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub

如果您要删除duplicares，整行请尝试下面的代码。

Sub RemoveDuplicatesCells_EntireRow()

Dim rng As Range, LastRow As Long

LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row

Set rng = Range("A1", Range("B" & LastRow))
rng.EntireRow.RemoveDuplicates Columns:=Array(1, 2), Header:=xlYes

End Sub

我希望这有助于萌芽！

Function VerifySumofShares() 'As Integer

'Application.ScreenUpdating = False
'Application.Calculation = xlManual

' having names for each comparing part to make the if statment easier

Dim NBG_ComparisonRegion As Excel.Worksheet
Dim NBG_Region As Excel.Worksheet
Dim Issue_SumofShares As Excel.Worksheet
Dim NBG_DataWorksheetName As Excel.Worksheet
Dim NBGMonth As String, NBGYear As String
Dim NBGCarmaker As String, NBGProject As String
Dim NBGFamily As String, NBGStatus As String
Dim NBGShare As Integer, NBGCst As String
Dim SOP As String, Status As String
Dim Customer As String, Product As String
Dim Responsible As String, Family As String
Dim Project As String, carmaker As String
Dim Share As String, GeoRegion As String
Dim CompMonth As String, CompYear As String
Dim CompCarmaker As String, CompProject As String
Dim CompFamily As String, CompStatus As String
Dim CompShare As Integer, CompCst As String
Dim RNumber As Integer, MAX_Row As Long
Dim MAX_Row1 As Long, Row As Integer
Dim Row1 As Integer, Issue_SumofSharesCnt As Integer
Dim Region As String

Set NBG_ComparisonRegion = Sheets("NBG_ComparisonRegionData")
Set NBG_Region = Sheets("NBG_RegionaData")
Set Issue_SumofShares = Sheets("Issue_SumofShares")
Set NBG_DataWorksheetName = Sheets("NBG_DataSheetName")

'Get the number of rows in NBG_Data_Comparison_Region
MAX_Row = NBG_ComparisonRegion.UsedRange.Rows.Count
'Get the number of rows in NBG_Data_Region
MAX_Row1 = NBG_Region.UsedRange.Rows.Count

'Count the Sum of shares for same projects which <> 1
Issue_SumofSharesCnt = 0

Issue_SumofShares.Cells.Clear

' Customize Issue_SumofShares sheet

Issue_SumofShares.Cells(1, 1) = "Report of projects with multiple customers" & _
                            "and Sum of Shares that does not equal 100%"

With Issue_SumofShares.Cells(1, 1)
    .Font.Bold = True
    .Font.Size = 14
    .Font.Color = RGB(255, 0, 0)
End With

SOP = "C"
Status = "AD"
Customer = "A"
Product = "B"
Responsible = "AT"
Family = "AA"
Project = "AB"
carmaker = "AJ"
Share = "BQ"
GeoRegion = "BF"

With Issue_SumofShares
    .Range("A2") = "Data Row"
    .Range("F2") = "Project"
    .Range("C2") = "SOP (dd-Month-yy QQ)"
    .Range("D2") = "Product"
    .Range("I2") = "Responsible"
    .Range("E2") = "Family"
    .Range("G2") = "Carmaker"
    .Range("H2") = "Share"
    .Range("B2") = "Customer"
    .Range("J2") = "Region"
    .Range("K2") = "Status"
    .Range("A2:Z2").Font.Bold = True
  End With

 ' Take the data of the NBG_Data_Comparison_Region
 For Row = 2 To MAX_Row

 'CompMonth = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, SOP).Value
 'CompMonth = DatePart("m", CompMonth)

 CompYear = NBG_ComparisonRegion.Cells(Row, SOP).Value
 CompYear = DatePart("yyyy", CompYear)
 CompCarmaker = NBG_ComparisonRegion.Cells(Row, carmaker).Value
 CompProject = NBG_ComparisonRegion.Cells(Row, Project).Value
 CompFamily = NBG_ComparisonRegion.Cells(Row, Family).Value
 CompStatus = NBG_ComparisonRegion.Cells(Row, Status).Value
 CompShare = NBG_ComparisonRegion.Cells(Row, Share).Value
 CompCst = NBG_ComparisonRegion.Cells(Row, "A").Value

 ' Take the data from NBG_Data_Region sheet to be compared with each row of the NBG_Data_Comparison_Region sheet

For Row1 = 2 To MAX_Row1

If Row1 >= MAX_Row1 Then
  Exit For
End If


'NBGMonth = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, SOP).Value
'NBGMonth = DatePart("m", NBGMonth)

 NBGYear = NBG_Region.Cells(Row1, SOP).Value
 NBGYear = DatePart("yyyy", NBGYear)
 NBGCarmaker = NBG_Region.Cells(Row1, carmaker).Value
 NBGProject = NBG_Region.Cells(Row1, Project).Value
 NBGFamily = NBG_Region.Cells(Row1, Family).Value
 NBGStatus = NBG_Region.Cells(Row1, Status).Value
 NBGShare = NBG_Region.Cells(Row1, Share).Value
 NBGCst = NBG_Region.Cells(Row1, "A").Value ' error = 1


Application.StatusBar = "VerifySumofShares. Progress: " & Row & " of " &    MAX_Row

   'Check if any row with a SOP date in the previous or current years and if it is a D-IN or OPP is found and add it to the IssueSOP_Date sheet

   ' NAF 20161208
   'Test with comparison of YEAR and MONTH
   ' If (NBGMonth = CompMonth And NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then
   ' With Year only
If (NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then

        'Customization of the Issue_SumofShares sheet to show the NBG Data Row , Cst, SOP , Product, Responsible,Family , Carmaker , Share , Status and the GeoRegion of the data which the condition applies to
        'NBGStatus <> "LOST" And CompStatus <> "LOST" And
        'And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <= 0.99 And CompShare + NBGShare > 1

     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "A").Value = Row1
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "B").Value = NBG_Region.Cells(Row1, Customer).Value
     'Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "C").Value = GetMonthAndQuarter(NBG_Region.Cells(Row1, SOP).Value)
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "D").Value = NBG_Region.Cells(Row1, Product).Value
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "E").Value = NBG_Region.Cells(Row1, Family).Value
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "F").Value = NBG_Region.Cells(Row1, Project).Value
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "G").Value = NBG_Region.Cells(Row1, carmaker).Value
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "H").Value = NBG_Region.Cells(Row1, Share).Value
     Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "I").Value = NBG_Region.Cells(Row1, Responsible).Value
    ' Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "K").Value = WNBG_Region.Cells(Row1, Status).Value

      Region = ""


    If NBG_DataWorksheetName.Cells(Row1, "BC") Then ' error  "BC" = 55
        Region = Region + "@EMEA"
    End If

    If NBG_DataWorksheetName.Cells(Row1, "BD") Then ' error  "BD" = 56
        Region = Region + "@AMERICAS"
    End If

    If NBG_DataWorksheetName.Cells(Row1, "BE") Then ' error  "BC" = 57
        Region = Region + "@GCSA"
    End If

    If NBG_DataWorksheetName.Cells(Row1, "BF") Then ' error  "BC" = 58
        Region = Region + "@JAPAN&KOREA"
    End If

    Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, "J").Value = Region '< Going to have issues "J" Is not a number - should be 10

    Issue_SumofSharesCnt = Issue_SumofSharesCnt + 1



    ElseIf (NBG_ComparisonRegion.Cells(Row, SOP).Value = "There are no items to show in this view.") Then

 End If

    ' Call DeleteRows

 Next Row1

 Next Row


VerifySumofShares = Issue_SumofSharesCnt


CleanUp:

   Application.ScreenUpdating = True
   Application.Calculation = xlAutomatic

   Set NBG_ComparisonRegion = Nothing
   Set NBG_Region = Nothing
   Set Issue_SumofShares = Nothing
   Set NBG_DataWorksheetName = Nothing

 End Function

有很多问题我试图用笔记修复它们中的一堆。如果您在修复其余问题时请告诉我。

    Sub VerifySumofShares()

    'Application.ScreenUpdating = False
    'Application.Calculation = xlManual

    ' having names for each comparing part to make the if statment easier

    Dim NBG_ComparisonRegion As Excel.Worksheet
    Dim NBG_Region As Excel.Worksheet
    Dim Issue_SumofShares As Excel.Worksheet
    Dim NBG_DataWorksheetName As Excel.Worksheet
    Dim NBGMonth As String, NBGYear As String
    Dim NBGCarmaker As String, NBGProject As String
    Dim NBGFamily As String, NBGStatus As String
    Dim NBGShare As Integer, NBGCst As String
    Dim SOP As String, Status As String
    Dim Customer As String, Product As String
    Dim Responsible As String, Family As String
    Dim Project As String, carmaker As String
    Dim Share As String, GeoRegion As String
    Dim CompMonth As String, CompYear As String
    Dim CompCarmaker As String, CompProject As String
    Dim CompFamily As String, CompStatus As String
    Dim CompShare As Integer, CompCst As String
    Dim RNumber As Integer, MAX_Row As Long
    Dim MAX_Row1 As Long, Row As Integer
    Dim Row1 As Integer, Issue_SumofSharesCnt As Integer
    Dim Region As String

    Set NBG_ComparisonRegion = Sheets("NBG_ComparisonRegionData")
    Set NBG_Region = Sheets("NBG_RegionaData")
    Set Issue_SumofShares = Sheets("Issue_SumofShares")
    Set NBG_DataWorksheetName = Sheets("NBG_DataSheetName")

    'Get the number of rows in NBG_Data_Comparison_Region
    MAX_Row = NBG_ComparisonRegion.UsedRange.Rows.Count
    'Get the number of rows in NBG_Data_Region
    MAX_Row1 = NBG_Region.UsedRange.Rows.Count

    'Count the Sum of shares for same projects which <> 1
    Issue_SumofSharesCnt = 0

    Issue_SumofShares.Cells.Clear

    ' Customize Issue_SumofShares sheet

    Issue_SumofShares.Cells(1, 1) = "Report of projects with multiple customers" & _
                                "and Sum of Shares that does not equal 100%"

    With Issue_SumofShares.Cells(1, 1)
        .Font.Bold = True
        .Font.Size = 14
        .Font.Color = RGB(255, 0, 0)
    End With

    SOP = 3
    Status = 30
    Customer = 1
    Product = 2
    Responsible = 46
    Family = 27
    Project = 28
    carmaker = 36
    Share = 69
    GeoRegion = 58

    With Issue_SumofShares
        .Range("A2") = "Data Row"
        .Range("F2") = "Project"
        .Range("C2") = "SOP (dd-Month-yy QQ)"
        .Range("D2") = "Product"
        .Range("I2") = "Responsible"
        .Range("E2") = "Family"
        .Range("G2") = "Carmaker"
        .Range("H2") = "Share"
        .Range("B2") = "Customer"
        .Range("J2") = "Region"
        .Range("K2") = "Status"
        .Range("A2:Z2").Font.Bold = True
      End With

     ' Take the data of the NBG_Data_Comparison_Region
     For Row = 2 To MAX_Row

     'CompMonth = Worksheets(NBG_ComparisonRegionDataWorksheetName).Cells(Row, SOP).Value
     'CompMonth = DatePart("m", CompMonth)

     CompYear = NBG_ComparisonRegion.Cells(Row, SOP).Value
     CompYear = DatePart("yyyy", CompYear)
     CompCarmaker = NBG_ComparisonRegion.Cells(Row, carmaker).Value
     CompProject = NBG_ComparisonRegion.Cells(Row, Project).Value
     CompFamily = NBG_ComparisonRegion.Cells(Row, Family).Value
     CompStatus = NBG_ComparisonRegion.Cells(Row, Status).Value
     CompShare = NBG_ComparisonRegion.Cells(Row, Share).Value
     CompCst = NBG_ComparisonRegion.Cells(Row, 1).Value

     ' Take the data from NBG_Data_Region sheet to be compared with each row of the NBG_Data_Comparison_Region sheet

    For Row1 = 2 To MAX_Row1

    If Row1 >= MAX_Row1 Then
      Exit For
    End If


    'NBGMonth = Worksheets(NBG_RegionaDataWorksheetName).Cells(Row1, SOP).Value
    'NBGMonth = DatePart("m", NBGMonth)

     NBGYear = NBG_Region.Cells(Row1, SOP).Value
     NBGYear = DatePart("yyyy", NBGYear)
     NBGCarmaker = NBG_Region.Cells(Row1, carmaker).Value
     NBGProject = NBG_Region.Cells(Row1, Project).Value
     NBGFamily = NBG_Region.Cells(Row1, Family).Value
     NBGStatus = NBG_Region.Cells(Row1, Status).Value
     NBGShare = NBG_Region.Cells(Row1, Share).Value
     NBGCst = NBG_Region.Cells(Row1, 1).Value


    Application.StatusBar = "VerifySumofShares. Progress: " & Row & " of " & MAX_Row

       'Check if any row with a SOP date in the previous or current years and if it is a D-IN or OPP is found and add it to the IssueSOP_Date sheet

       ' NAF 20161208
       'Test with comparison of YEAR and MONTH
       ' If (NBGMonth = CompMonth And NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then
       ' With Year only
    If (NBGYear = CompYear And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <> 1 And NBGCst <> CompCst) Then

            'Customization of the Issue_SumofShares sheet to show the NBG Data Row , Cst, SOP , Product, Responsible,Family , Carmaker , Share , Status and the GeoRegion of the data which the condition applies to
            'NBGStatus <> "LOST" And CompStatus <> "LOST" And
            'And CompCarmaker = NBGCarmaker And CompProject = NBGProject And CompFamily = NBGFamily And CompShare + NBGShare <= 0.99 And CompShare + NBGShare > 1

         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 1).Value = Row1
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 2).Value = NBG_Region.Cells(Row1, Customer).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 3).Value = GetMonthAndQuarter(NBG_Region.Cells(Row1, SOP).Value)
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 4).Value = NBG_Region.Cells(Row1, Product).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 5).Value = NBG_Region.Cells(Row1, Family).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 6).Value = NBG_Region.Cells(Row1, Project).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 7).Value = NBG_Region.Cells(Row1, carmaker).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 8).Value = NBG_Region.Cells(Row1, Share).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 9).Value = NBG_Region.Cells(Row1, Responsible).Value
         Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 11).Value = WNBG_Region.Cells(Row1, Status).Value

          Region = ""


        If NBG_DataWorksheetName.Cells(Row1, 55) Then
            Region = Region + "@EMEA"
        End If

        If NBG_DataWorksheetName.Cells(Row1, 56) Then
            Region = Region + "@AMERICAS"
        End If

        If NBG_DataWorksheetName.Cells(Row1, 57) Then
            Region = Region + "@GCSA"
        End If

        If NBG_DataWorksheetName.Cells(Row1, 58) Then
            Region = Region + "@JAPAN&KOREA"
        End If

        Issue_SumofShares.Cells(3 + Issue_SumofSharesCnt, 10).Value = Region '< Going to have issues "J" Is not a number - should be 10

        Issue_SumofSharesCnt = Issue_SumofSharesCnt + 1



        ElseIf (NBG_ComparisonRegion.Cells(Row, SOP).Value = "There are no items to show in this view.") Then

     End If

     Next Row1

     Next Row

        Call RemoveDuplicatesCells_EntireRow ' I would remove from the loop - makes your code slow not unless needed

    'VerifySumofShares = Issue_SumofSharesCnt

    MsgBox Issue_SumofSharesCnt

    Debug.Print Issue_SumofSharesCnt

 CleanUp:

       Application.ScreenUpdating = True
       Application.Calculation = xlAutomatic

       Set NBG_ComparisonRegion = Nothing
       Set NBG_Region = Nothing
       Set Issue_SumofShares = Nothing
       Set NBG_DataWorksheetName = Nothing

     End Sub

我的建议是这样的。

VBA excel Duplicate Removal无法正常工作

1 个答案: