


Imports System.Globalization
Imports Microsoft.Office.Interop


Public Class frmBH_SollHaben


    Private Function loadExcel() As Boolean
        ' Call ShowDialog.

        Dim fd As New OpenFileDialog
        fd.Filter = "Excel Dateien|*.xls;*.xlsx"
        Dim result As DialogResult = fd.ShowDialog()

        If Not fd.FileName.EndsWith(".xls") And Not fd.FileName.EndsWith(".xlsx") Then Exit Function


        If result = System.Windows.Forms.DialogResult.OK Then
            ' MsgBox("start0")
            lblOpen.Visible = True
            'Label1.Visible = True
            '  Button1.Enabled = False
            Me.Cursor = Cursors.WaitCursor
            Dim exclApp As New Excel.Application 'Object 'as Application
            Dim Datei As Excel.Workbook ' 'as WorkBook
            Dim Blatt As Excel.Worksheet 'Object 'as WorkSheet
            ' exclApp = CreateObject("Excel.Application")

            With exclApp
                Try

                    ' .Visible = False
                    ' Dim GuiId As String = System.Guid.NewGuid().ToString().ToUpper()
                    ' exclApp.Caption = GuiId
                    exclApp.CutCopyMode = False


                    Datei = .Workbooks.Open(fd.FileName)
                    Blatt = Datei.Worksheets(1)
                
                    Datei.Activate()


                    Try
                        Blatt.ShowAllData() 'Falls Filter ausgewählt wurde
                    Catch ex As Exception

                    End Try


                    
                    Dim startFound As Boolean = False
                    Dim endFound As Boolean = False


                    Dim startRows As Integer = 1
                    While startRows < Blatt.UsedRange.Rows.Count
                        If Blatt.Range("A" & startRows).Value IsNot Nothing AndAlso Blatt.Range("A" & startRows).Value.ToString = "Belegdat." Then
                            startRows += 2
                            startFound = True
                            Exit While
                        End If
                        startRows += 1
                    End While


                    ' MsgBox("startRows" & startRows)

                    Dim endRows As Integer = Blatt.UsedRange.Rows.Count
                    While endRows > 0
                        If Not Blatt.Range("B" & endRows) Is Nothing Then
                            If Blatt.Range("B" & endRows).Value = "Summe:" Then
                                endRows -= 1
                                endFound = True
                                Exit While
                            End If
                        End If
                        endRows -= 1
                    End While

                    Dim tabu As New List(Of Integer)


                    '__________________

                    'Laden des Bereiches aus dem Excel:
                    Dim myRange As Excel.Range
                    myRange = Blatt.Range("A" & startRows & ":H" & endRows & "")
                    Dim myArray As Object(,) '<-- declared as 2D Array
                    myArray = myRange.Value    'store the content of each cell

                    'AUSZIFFERN SOLL
                    Dim ausziffern_soll As Integer = 1

                    lblSoll.Visible = True
                    Try
                        For i_soll As Integer = startRows To endRows Step 1
                            For i_soll2 As Integer = startRows To endRows Step 1
                                Dim soll As Object = myArray(i_soll - startRows + 1, 5)
                                Dim soll2 As Object = myArray(i_soll2 - startRows + 1, 5)
                                If Not soll Is Nothing AndAlso Not soll2 Is Nothing Then

                                    If isNotTabu2(tabu, i_soll, i_soll2) Then ' wurde diese zeile schon ausgeziffert?
                                        If Not soll Is Nothing AndAlso Not soll2 Is Nothing Then
                                            If soll.ToString.Trim <> "" AndAlso soll2.ToString.Trim <> "" Then

                                                If CDbl(soll) + CDbl(soll2) = CDbl(0) Then
                                                    If checkNothingEmptyBool(myArray(i_soll - startRows + 1, 3)) AndAlso checkNothingEmptyBool(myArray(i_soll2 - startRows + 1, 3)) Then
                                                        Dim sollNr As String = getnumberFromSollHaben(myArray(i_soll - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        Dim habenNr As String = getnumberFromSollHaben(myArray(i_soll2 - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        'MsgBox("sollNr" & myArray(i_soll - startRows + 1, 3).ToString & " - " & sollNr)
                                                        'MsgBox("habenNr" & myArray(i_haben - startRows + 1, 3).ToString & " - " & habenNr)
                                                        If (sollNr.Trim <> "" AndAlso habenNr.Trim <> "" AndAlso sollNr = habenNr) Or (myArray(i_soll - startRows + 1, 3).ToString = myArray(i_soll2 - startRows + 1, 3).ToString) Then 'posNr vergleichen, oder fall der ganze Text exakt übereinstimmt
                                                            '  MsgBox(CDbl(soll) & " _ " & CDbl(soll2))
                                                            Blatt.Range("K" & i_soll).Value = ausziffern_soll
                                                            Blatt.Range("K" & i_soll2).Value = ausziffern_soll
                                                            Blatt.Range("A" & i_soll & ":K" & i_soll).Font.Color = Color.RoyalBlue
                                                            Blatt.Range("A" & i_soll2 & ":K" & i_soll2).Font.Color = Color.RoyalBlue
                                                            ausziffern_soll += 1
                                                            tabu.Add(i_soll)
                                                            tabu.Add(i_soll2)
                                                            Exit For
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            Next
                            lblSoll.Text = "SOLL Auszifferung... " & CInt(i_soll / (endRows / 100)) & "%"
                        Next
                    Catch ex As Exception
                        lblFehler.Visible = True
                        Button1.Visible = True
                        Me.Cursor = Cursors.Default
                        MsgBox(ex.Message)
                        Return False
                    End Try
                    lblSoll.Text = "SOLL Auszifferung OK"


                    'AUSZIFFERN Haben
                    Dim ausziffern_haben As Integer = 1
                    ' Dim tabu_haben As New List(Of Integer)
                    lblHaben.Visible = True
                    Try
                        For i_soll As Integer = startRows To endRows Step 1
                            For i_soll2 As Integer = startRows To endRows Step 1
                                Dim soll As Object = myArray(i_soll - startRows + 1, 6)
                                Dim soll2 As Object = myArray(i_soll2 - startRows + 1, 6)
                                If Not soll Is Nothing AndAlso Not soll2 Is Nothing Then

                                    If isNotTabu2(tabu, i_soll, i_soll2) Then ' wurde diese zeile schon ausgeziffert?
                                        If Not soll Is Nothing AndAlso Not soll2 Is Nothing Then
                                            If soll.ToString.Trim <> "" AndAlso soll2.ToString.Trim <> "" Then

                                                If CDbl(soll) + CDbl(soll2) = CDbl(0) Then
                                                    If checkNothingEmptyBool(myArray(i_soll - startRows + 1, 3)) AndAlso checkNothingEmptyBool(myArray(i_soll2 - startRows + 1, 3)) Then

                                                        Dim sollNr As String = getnumberFromSollHaben(myArray(i_soll - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        Dim habenNr As String = getnumberFromSollHaben(myArray(i_soll2 - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        'MsgBox("sollNr" & myArray(i_soll - startRows + 1, 3).ToString & " - " & sollNr)
                                                        'MsgBox("habenNr" & myArray(i_haben - startRows + 1, 3).ToString & " - " & habenNr)
                                                        If (sollNr.Trim <> "" AndAlso habenNr.Trim <> "" AndAlso sollNr = habenNr) Or (myArray(i_soll - startRows + 1, 3).ToString = myArray(i_soll2 - startRows + 1, 3).ToString) Then 'posNr vergleichen, oder fall der ganze Text exakt übereinstimmt
                                                            '  MsgBox(CDbl(soll) & " _ " & CDbl(soll2))
                                                            Blatt.Range("K" & i_soll).Value = ausziffern_haben
                                                            Blatt.Range("K" & i_soll2).Value = ausziffern_haben
                                                            Blatt.Range("A" & i_soll & ":K" & i_soll).Font.Color = Color.RoyalBlue
                                                            Blatt.Range("A" & i_soll2 & ":K" & i_soll2).Font.Color = Color.RoyalBlue
                                                            ausziffern_haben += 1
                                                            tabu.Add(i_soll)
                                                            tabu.Add(i_soll2)
                                                            Exit For
                                                        End If

                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            Next
                            lblHaben.Text = "HABEN Auszifferung... " & CInt(i_soll / (endRows / 100)) & "%"
                        Next
                    Catch ex As Exception
                        lblFehler.Visible = True
                        Button1.Visible = True
                        Me.Cursor = Cursors.Default
                        MsgBox(ex.Message)
                        Return False
                    End Try
                    lblHaben.Text = "HABEN Auszifferung OK"


                    'SOLL/HABEN ausziffern
                    Dim ausziffern As Integer = 1
                    'Dim tabu As New List(Of Integer)
                    Dim POS_NR = False 'posNr vergleichen
                    Try
                        lblSollHaben.Visible = True
                        For i_soll As Integer = startRows To endRows Step 1
                            For i_haben As Integer = startRows To endRows Step 1
                                Dim soll As Object = myArray(i_soll - startRows + 1, 5)
                                Dim haben As Object = myArray(i_haben - startRows + 1, 6)
                                If Not soll Is Nothing AndAlso Not haben Is Nothing Then
                                    If isNotTabu2(tabu, i_soll, i_haben) Then ' wurde diese zeile schon ausgeziffert?
                                        If Not soll Is Nothing AndAlso Not haben Is Nothing Then
                                            If soll.ToString.Trim <> "" AndAlso haben.ToString.Trim <> "" Then
                                                'TextBox1.Text = myArray(i_soll - startRows + 1, 3) & " - " & myArray(i_soll2 - startRows + 1, 3)
                                                '    MsgBox(soll.ToString & " _ " & haben.ToString)
                                                If soll.ToString = haben.ToString Then
                                                    If checkNothingEmptyBool(myArray(i_soll - startRows + 1, 3)) AndAlso checkNothingEmptyBool(myArray(i_haben - startRows + 1, 3)) Then
                                                        Dim sollNr As String = getnumberFromSollHaben(myArray(i_soll - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        Dim habenNr As String = getnumberFromSollHaben(myArray(i_haben - startRows + 1, 3)) 'posNr aus zelle suchen
                                                        'MsgBox("sollNr" & myArray(i_soll - startRows + 1, 3).ToString & " - " & sollNr)
                                                        'MsgBox("habenNr" & myArray(i_haben - startRows + 1, 3).ToString & " - " & habenNr)
                                                        If Not POS_NR OrElse (sollNr.Trim <> "" AndAlso habenNr.Trim <> "" AndAlso sollNr = habenNr) Then 'posNr vergleichen
                                                            '   MsgBox("OK3")
                                                            Blatt.Range("J" & i_soll).Value = ausziffern
                                                            Blatt.Range("J" & i_haben).Value = ausziffern
                                                            Blatt.Range("A" & i_soll & ":J" & i_soll).Font.Color = Color.Red
                                                            Blatt.Range("A" & i_haben & ":J" & i_haben).Font.Color = Color.Red
                                                            ausziffern += 1
                                                            tabu.Add(i_soll)
                                                            tabu.Add(i_haben)
                                                            Exit For
                                                        End If
                                                    End If
                                                End If
                                            End If
                                        End If
                                    End If
                                End If
                            Next
                            lblSollHaben.Text = "SOLL/HABEN Auszifferung... " & CInt(i_soll / (endRows / 100)) & "%"
                        Next
                        lblSollHaben.Text = "SOLL/HABEN Auszifferung OK"
                    Catch ex As Exception

                        lblFehler.Visible = True
                        Button1.Visible = True
                        Me.Cursor = Cursors.Default
                        MsgBox(ex.Message)

                        Return False
                    End Try

                    Blatt.Range("J" & (startRows - 2)).Value = "SOLL/HABEN Ausziff."
                    Blatt.Range("K" & (startRows - 2)).Value = "Einseitige Ausziff."

                    Blatt.Range("A1:K1").EntireColumn.AutoFit()

                    lblExcel.Visible = True
                    Me.Cursor = Cursors.Default

                    .Visible = True
                    AddHandler exclApp.WorkbookBeforeClose, AddressOf BeforeBookClose
                    'Excelobjekte freistellten
                    For Each obj In New Object() {exclApp, Datei, Datei, Blatt, Blatt}
                        System.Runtime.InteropServices.Marshal.FinalReleaseComObject(obj)
                    Next

                Catch ex As Exception
                    lblFehler.Visible = True
                    Button1.Visible = True
                    Me.Cursor = Cursors.Default
                    MsgBox("FEHLER! Wurde die richtige Datei ausgewählt?" & vbNewLine & vbNewLine & ex.Message)
                    Return False
                End Try
            End With
            Return True
        Else
            Me.Close()
            Return False
        End If
        Me.Enabled = True
        Me.Cursor = Cursors.Default

        Return False

    End Function

    Function checkNothingEmptyBool(s) As Boolean
        If s Is Nothing Then Return False
        If s = "" Then Return False
        Return True
    End Function
    Function getnumberFromSollHaben(s As Object) As String
        If Not s Is Nothing AndAlso s.ToString <> "" Then
            If matchFormat(s.ToString) Then
                getnumberFromSollHaben = getNumberFromBehindMatching(s.ToString)
            Else
                getnumberFromSollHaben = getNumberFromBehind(s.ToString)
            End If
        Else
            getnumberFromSollHaben = ""
        End If
    End Function

    Function matchFormat(s As String) As Boolean
        If Not s.Length = 16 Then Return False
        If Not s(4) = "/" Then Return False
        If Not s(13) = "/" Then Return False
        If Not IsNumeric(s.ToString.Substring(0, 4)) Then Return False
        If Not IsNumeric(s.ToString.Substring(5, 8)) Then Return False
        If Not IsNumeric(s.ToString.Substring(14, 2)) Then Return False
        Return True
    End Function

    Function getNumberFromBehind(s As String) As String
        Dim startint As Boolean = False
        Dim int As String = ""

        For i As Integer = s.Length - 1 To 0 Step -1
            If startint And Not IsNumeric(s(i)) Then
                If int.Length < 3 Then ' Wenn die Zahl kleiner als 3 ist, kann Sie nicht stimmen, --> weitersuchen
                    startint = False 'Param zurücksetzen
                    int = "" 'Param zurücksetzen
                Else
                    Exit For 'Zahl stimmt, suche wird beendet
                End If
            End If
            If IsNumeric(s(i)) Then
                int = s(i) & int
                startint = True
            End If
        Next
        While int.Length > 1 AndAlso int.StartsWith("0")
            int = int.Substring(1, int.Length - 1)
        End While
        Return int
    End Function

    Function getNumberFromBehindMatching(s As String) As String
        Dim int As String = s.ToString.Substring(8, 5)
        While int.Length > 1 AndAlso int.StartsWith("0")
            int = int.Substring(1, int.Length - 1)
        End While
        Return int
    End Function


    Private Sub BeforeBookClose(ByVal Wb As Excel.Workbook, ByRef Cancel As Boolean)
        ' Wb.Application.Quit()
        'Wb.Close()

        Me.Close()
    End Sub
    Private Sub frmMDM_BH_SollHaben_Load(sender As Object, e As EventArgs) Handles Me.Load
        lblSoll.Text = "Laden... 0%"
        Me.Show()
        Me.BringToFront()
        loadExcel()
    End Sub
    Function isNotTabu(tabu As List(Of Integer), i_haben As Integer) As Boolean
        If Not tabu Is Nothing Then
            For Each t In tabu
                If t = i_haben Then Return False
            Next
        End If
        Return True
    End Function
    Function isNotTabu2(tabu As List(Of Integer), w1 As Integer, w2 As Integer) As Boolean
        If Not tabu Is Nothing Then
            For Each t In tabu
                If t = w2 Then Return False
                If t = w1 Then Return False
            Next
        End If
        Return True
    End Function
    Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
        Me.Close()
    End Sub
End Class