VB.NET删除奇偶校验范围内的重复项

Question

我下面的应用程序检查一个工作簿，该工作簿中有一个用序列号标识的特定月份销售的商品列表。项目旁边还有一个注释列。

每个月当我运行应用程序时，它都会告诉我是否售出了同一件商品，以及商品旁边的评论。

"在标签为2014年8月的工作表中发现项目"对该项目的评论"

如果我在工作簿上再次运行该应用程序，当它添加了其他工作表时，它将再次添加"找到的项…"。

我有从第20列开始的结果，我只需要删除这些列中的重复项。

Option Explicit On
Option Infer Off
Imports System.Net.Mail
Imports System.IO
Imports Microsoft.Office.Interop
Imports Microsoft.Office.Interop.Excel
Imports System.Runtime.InteropServices
Imports Excel = Microsoft.Office.Interop.Excel
Imports System.Text.RegularExpressions

Public Class Form1
Dim fileName As String = ""
Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

End Sub
Private Function ColumnIndexToColumnLetter(colIndex As Integer) As String
    Dim div As Integer = colIndex
    Dim colLetter As String = String.Empty
    Dim modnum As Integer = 0
    While div > 0
        modnum = (div - 1) Mod 26
        colLetter = Chr(65 + modnum) & colLetter
        div = CInt((div - modnum)  26)
    End While
    Return colLetter
End Function
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
    Button1.Enabled = False
    Button1.Text = "Patience"
    Button1.Refresh()
    System.Windows.Forms.Application.DoEvents()
    Dim app As New Excel.Application
    app.Visible = False

    Dim wbBase As Excel.Workbook = app.Workbooks.Open(TextBox1.Text)

    '   * create style *
    '
    Dim xlStyles As Excel.Styles = wbBase.Styles
    Dim xlStyle As Excel.Style = Nothing
    Dim isstyleexists As Boolean = False
    '
    '   * check if this style exist *
    '
    For Each xlStyle In xlStyles
        If xlStyle.Name = "NewStyle" Then
            isstyleexists = True
            Exit For
        End If
    Next
    '
    '   * if this does not exist so add new one *
    '               ' get Range "A1"
    If (Not isstyleexists) Then
        xlStyles.Add("NewStyle")
        xlStyle = xlStyles.Item("NewStyle")
    End If



    Dim snName As String
    Dim snName2 As String
    Dim cmt2 As String
    For Each basesheet As Excel.Worksheet In wbBase.Sheets
        Dim iiii As Integer = basesheet.Cells(1, basesheet.Columns.Count).End(Excel.XlDirection.xlToLeft).Column + 1
        Dim iii As Integer = basesheet.Cells(1, basesheet.Columns.Count).End(Excel.XlDirection.xlToLeft).Column + 1
        Dim iv As Integer = iii + 1
        For i As Integer = 1 To 20
            If Not basesheet.Cells(1, i).Value Is Nothing AndAlso basesheet.Cells(1, i).Value.Contains("Serial Number") Then
                snName = ColumnIndexToColumnLetter(i)
                Exit For
            End If
        Next
        If Not snName Is Nothing Then
            For Each checksheet As Excel.Worksheet In wbBase.Sheets
                If basesheet.Name <> checksheet.Name Then
                    For i As Integer = 1 To 20
                        If Not checksheet.Cells(1, i).Value Is Nothing AndAlso checksheet.Cells(1, i).Value.Contains("Serial Number") Then
                            snName2 = ColumnIndexToColumnLetter(i)
                            Exit For
                        End If
                    Next
                    For i As Integer = 1 To 20
                        If Not checksheet.Cells(1, i).Value Is Nothing AndAlso checksheet.Cells(1, i).Value.Contains("Comments") Then
                            cmt2 = ColumnIndexToColumnLetter(i)
                            Exit For
                        End If
                    Next
                    If Not snName2 Is Nothing Then
                        Dim baseobj As Object = basesheet.Range(snName & "2:" & snName & basesheet.Range(snName & basesheet.Rows.Count).End(Excel.XlDirection.xlUp).Row).Value
                        Dim checkobj As Object = checksheet.Range(snName2 & "2:" & snName2 & checksheet.Range(snName2 & checksheet.Rows.Count).End(Excel.XlDirection.xlUp).Row).Value
                        Dim cmtobj As Object = checksheet.Range(cmt2 & "2:" & cmt2 & checksheet.Range(snName2 & checksheet.Rows.Count).End(Excel.XlDirection.xlUp).Row).Value
                        Dim basetmp(DirectCast(baseobj, Object(,)).Length, 1) As Object
                        Dim v As Integer = 0
                        Dim bool As Boolean = False
                        For i As Integer = 1 To DirectCast(baseobj, Object(,)).Length
                            For ii As Integer = 1 To DirectCast(checkobj, Object(,)).Length
                                If Not baseobj(i, 1) Is Nothing AndAlso Not checkobj(ii, 1) Is Nothing AndAlso Trim(baseobj(i, 1).ToString) = Trim(checkobj(ii, 1).ToString) Then
                                    bool = True
                                    basetmp(i, 0) = "Serial # Exists in " & checksheet.Name
                                    basetmp(i, 1) = cmtobj(ii, 1)


                                End If
                            Next
                            v += 1
                        Next
                        If bool Then
                            basesheet.Range(basesheet.Cells(1, iii), basesheet.Cells(v, iv)).Style = "NewStyle"
                            basesheet.Range(basesheet.Cells(1, iii), basesheet.Cells(v, iv)).Borders.Weight = Excel.XlBorderWeight.xlThin
                            basesheet.Range(basesheet.Cells(1, iii), basesheet.Cells(v, iv)).Borders.LineStyle = Excel.XlLineStyle.xlContinuous
                            basesheet.Range(basesheet.Cells(1, iii), basesheet.Cells(v, iv)).Value = basetmp
                            basesheet.Cells(1, iii).value = "Results Found"
                            basesheet.Cells(1, iii).Font.Color = System.Drawing.ColorTranslator.ToOle(System.Drawing.Color.Red)
                            basesheet.Cells(1, iii).HorizontalAlignment = Excel.Constants.xlCenter
                            basesheet.Cells(1, iii).Font.Bold = True
                            basesheet.Columns.AutoFit()


                            iii += 2
                            iv += 2
                        End If
                    End If
                End If
            Next
        End If
    Next

    wbBase.Save()
    wbBase.Close()
    app.Quit()
    MessageBox.Show("Done", "Three in Thirty", MessageBoxButtons.OK)
    Button1.Text = "Start"
    Button1.Enabled = True
End Sub

Answer 1

看起来您每个月都在重新处理以前处理过的表单。避免重新处理旧图纸可能比避免重复处理旧图纸中的条目更容易。

与其使用嵌套的工作表循环，我可能会尝试以下模式：

* find basesheet
* find latest checksheet
* process the checksheet for items sold

如果用户可能不小心将东西添加到旧工作表中，那么我会考虑在进行处理时锁定旧工作表，以帮助确保数据的完整性。