VBA excel重复删除不能正常工作
我有一个button的function，一旦我点击它就会被激活，它显示数据行（具体条件，所以它不给所有的行回来）从一个新的工作表中调用（Issue_SumofShares）两个相同的工作表。问题在交叉检查时，由于将第一张表（NBG_RegionaData）中的所有行与第二张表中的第一行（NBG_ComparisonRegionData）进行比较，然后转到第二张表中的第二行，因此会重复这么多的数据行上 。 我知道我可以删除重复项（删除第一列和第二列中相同的值的行）手动或通过“删除重复”button，但我想删除重复自动当我按下button，在显示结果之前，所以我添加了DeleteRows子，并试图调用它，但它不工作，所以有人可以告诉我哪里出错或告诉我如何自动重复删除，它会自动发生在打开表（Issue_SumofShares）之前，按下button后。 这是我的代码：
' 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 您可能需要为您的图纸名称进行修改。 我testing了它，效果很好。
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
如果您正在删除重复项目，并且整行尝试下面的代码。
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
我的build议是这样的。