Textverschlüsselung mit VBA

Hallo Community,
bräuchte schon mal wieder Eure Hilfe.
Da geht um Text Verschlüsselung/Entschlüsselung.
In der Tabelle Verschlüsseln in der Zeile B2 wird manuell ein beliebiger Klartext manuell eingegeben und in der Zeile B3 manuell ein beliebiger Kennwort eingetragen.
In der Zeile B4 wird mittels Buttons Kennwort vereinfachen die mehrfachvorkommeden Buchstaben gestrichen.
Es müssen zwei Schritte programmiert werden
Schritt 1:
In der Tabelle1 ist die Spalte A fest definiert. In die Spalte B, ab Zeile B3 wird an das vereinfachten Kennwort (INTERSCH) das Alphabet in umgekehrter Reihenfolge angehängt. Wichtig: die Buchstaben sollen in der Spalte B nicht wiederholen und nur einmal in der Spalte B vorkommen. D.h.: wenn die Buchstabe N schon im vereinfachten Kennwort ist (INTERSCH), in dem Alphabet, das in umgekehrter Reihenfolge angehängt wird, soll die nicht mehr auftauchen (statt N kommt die nächstdrunterliegende Buchstabe M). So wird eine Spalte mit Geheimtext erzeugt.
Schritt 2:
Anhang vom dem Geheimtext (Tabelle1, Spalte B) soll der Klartext (Tabelle Verschlüsseln, Zeile B2) verschlüsselt und wieder entschlüsselt werden. Die Ergebnisse kommen dann in die Tabelle Verschlüsseln Zeilen B5/B6
Hatte schon was programmiert, leider komme nicht richtig weiter mit Arrays.
Würde über Eure Hilfe sehr freuen!
Anbei die Datei:
https://www.herber.de/bbs/user/127533.xlsm

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Zweck?

09.02.2019 18:08:07

Fennek

AW: Zweck?

09.02.2019 19:18:43

kocius

AW: VBA

09.02.2019 21:01:19

Fennek

AW: VBA

09.02.2019 21:02:13

Fennek

AW: VBA

10.02.2019 01:36:02

kocius

AW: VBA

10.02.2019 03:37:54

onur

AW: VBA

10.02.2019 10:42:51

kocius

erledigt

11.02.2019 11:42:15

kocius

Sub Dekodieren() Dim Pt As String, Ci As String Ci = Cells(5, 2) Tb = Sheets("Code").Range("A3:B28") For b = 1 To Len(Ci) For i = LBound(Tb) To UBound(Tb) If Mid(Ci, b, 1) = Tb(i, 2) Then Pt = Pt & Tb(i, 1) Next i Next b Cells(6, 2) = Pt End Sub

Sub Codieren() Dim Pt As String, Ci As String Pt = Cells(2, 2) Tb = Sheets("Code").Range("A3:B28") For b = 1 To Len(Pt) For i = LBound(Tb) To UBound(Tb) If Mid(Pt, b, 1) = Tb(i, 1) Then Ci = Ci & Tb(i, 2) Next i Next b Cells(5, 2) = Ci End Sub Sub Dekodieren() Dim Pt As String, Ci As String Ci = Cells(5, 2) Tb = Sheets("Code").Range("A3:B28") For b = 1 To Len(Ci) For i = LBound(Tb) To UBound(Tb) If Mid(Ci, b, 1) = Tb(i, 2) Then Pt = Pt & Tb(i, 1) Next i Next b Cells(6, 2) = Pt End Sub

Beliebteste Forumthreads (12 Monate)

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread