AW: Code in Module überall ausführen
07.05.2016 09:32:09
Helbo
Guten Tag,
Irgendwie klappte dies mit der Mail-Benachrichtigung nicht.
Option Explicit
Rem: Erzeugt die dPHID und prüft diese folgend
Sub dPHID()
Call dPHIDErzeugenundUpdaten
Call dPHIDPrüfen
End Sub
'************************************************************************************************************************************************************************************
'YYYY********************************************************************************************************************************************************************
Rem: Dieses Makro generiert die die dPHID und teilt diese den entsprechenden IOs zu
Sub dPHIDErzeugenundUpdaten()
Dim i, r As Integer
Dim LetzteZeile, maxZeile, minZeile, AktuelleZeile, AktuelleSpalte As Integer
maxZeile = FLetzteZeile_MSR_Projekt ' Werte von Globaler Funktion=> Siehe ModGeneral
minZeile = FErsteZeile_MSR_Projekt ' Werte von Globaler Funktion=> Siehe ModGeneral
For AktuelleZeile = minZeile To maxZeile
For AktuelleSpalte = con_dpDI_IO To con_dpAO_IO
With Sheets("MSR_Projekt")
If Cells(AktuelleZeile, AktuelleSpalte) "" Then
If Cells(AktuelleZeile, con_dpHID) = "" Then
Randomize Timer
Cells(AktuelleZeile, con_dpHID) = Int(100 * Rnd + 1) & AktuelleZeile & _
AktuelleSpalte
End If
End If
End With
Next
Next
End Sub
'************************************************************************************************************************************************************************************
YYYY
'************************************************************************************************************************************************************************************
Rem: Dieses Makro überprüft ob alle dPHID einzigartig sind und keine duplikate vorkommen
Sub dPHIDPrüfen()
Dim objDic As Object
Dim strDopp As String
Dim zelle As Variant
Dim maxZeile As Integer
On Error GoTo DoppelteDatenAusgeben_Error
With Sheets("MSR_Projekt")
maxZeile = .Cells(.Rows.Count, con_dpHID).End(xlUp).row ' Letzte Zeile von den dPHIDs
Set objDic = CreateObject("Scripting.Dictionary")
For Each zelle In .Range("CI49:CI" & maxZeile)
If zelle.Value "" Then
If objDic.exists(zelle.Value) = False Then
objDic(zelle.Value) = 0
Else
strDopp = strDopp & zelle.Value & vbLf
MsgBox "Es ist folgendes Duplikat in der dPHID Spalte vorhanden: " & _
strDopp
Exit Sub
End If
End If
Next zelle
MsgBox "Die dPHID wurde zugewiesen und ist einzigartig " & vbLf & strDopp
End With
On Error GoTo 0
Exit Sub
DoppelteDatenAusgeben_Error:
MsgBox "Error " & Err.Number & " (" & Err.Description & _
") in procedure DoppelteDatenAusgeben of Modul mdl_Dictionary"
End Sub
z.B dieses Makro lässt sich zwar ausführen. Jedoch werden die Werte nicht geschrieben. Dies ist bei vielen der Fall. Es wird ausgeführt, jedoch wird nichts in die entsprechende Zeile geschrieben.