386 lines
19 KiB
VB.net
386 lines
19 KiB
VB.net
|
|
|
|
|
|
Imports System.Globalization
|
|
Imports Microsoft.Office.Interop
|
|
|
|
|
|
Public Class frmBH_SollHaben
|
|
Public Sub New()
|
|
|
|
' Dieser Aufruf ist für den Designer erforderlich.
|
|
InitializeComponent()
|
|
|
|
' Fügen Sie Initialisierungen nach dem InitializeComponent()-Aufruf hinzu.
|
|
|
|
End Sub
|
|
|
|
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 |