FromPolytonicToMonotonic - Excel Λύσεις



‘Κώδικας για το Word:

Sub FromPolytonicToMonotonic()

'για Word

'από το Excel Λύσεις

Dim keimeno As Object

Dim Polytonic As Variant

Dim Monotonic As Variant

Dim i As Integer

Polytonic = VBA.Array(976, 977, 978, 979, 980, 981, 982, 983, 1008, 1009, 1010, 1012, 1013, _

7936, 7937, 7938, 7939, 7940, 7941, 7942, 7943, 7944, 7945, 7946, 7947, 7948, 7949, 7950, _

7951, 7952, 7953, 7954, 7955, 7956, 7957, 7960, 7961, 7962, 7963, 7964, 7965, 7968, 7969, _

7970, 7971, 7972, 7973, 7974, 7975, 7976, 7977, 7978, 7979, 7980, 7981, 7982, 7983, 7984, _

7985, 7986, 7987, 7988, 7989, 7990, 7991, 7992, 7993, 7994, 7995, 7996, 7997, 7998, 7999, 8000, _

8001, 8002, 8003, 8004, 8005, 8008, 8009, 8010, 8011, 8012, 8013, 8016, 8017, 8018, 8019, 8020, _

8021, 8022, 8023, 8025, 8027, 8029, 8031, 8032, 8033, 8034, 8035, 8036, 8037, 8038, 8039, 8040, _

8041, 8042, 8043, 8044, 8045, 8046, 8047, 8048, 8049, 8050, 8051, 8052, 8053, 8054, 8055, 8056, _

8057, 8058, 8059, 8060, 8061, 8064, 8065, 8066, 8067, 8068, 8069, 8070, 8071, 8072, 8073, 8074, _

8075, 8076, 8077, 8078, 8079, 8080, 8081, 8082, 8083, 8084, 8085, 8086, 8087, 8088, 8089, 8090, _

8091, 8092, 8093, 8094, 8095, 8096, 8097, 8098, 8099, 8100, 8101, 8102, 8103, 8104, 8105, 8106, _

8107, 8108, 8109, 8110, 8111, 8114, 8115, 8116, 8118, 8119, 8122, 8123, 8124, 8130, 8131, 8132, _

8134, 8135, 8136, 8137, 8138, 8139, 8140, 8146, 8147, 8150, 8151, 8154, 8155, 8162, 8163, 8164, _

8165, 8166, 8167, 8170, 8171, 8172, 8178, 8179, 8180, 8182, 8183, 8184, 8185, 8186, 8187, 8188, _

8127, 8141, 8142, 8143, 8157, 8158, 8159, 8175, 8189, 8190)

Monotonic = VBA.Array(946, 952, 933, 910, 939, 966, 960, 38, 954, 961, 963, 920, 949, 945, 945, _

940, 940, 940, 940, 940, 940, 913, 913, 902, 902, 902, 902, 902, 902, 949, 949, 941, 941, 941, _

941, 917, 917, 904, 904, 904, 904, 951, 951, 942, 942, 942, 942, 942, 942, 919, 919, 905, 905, _

905, 905, 905, 905, 953, 953, 943, 943, 943, 943, 943, 943, 921, 921, 906, 906, 906, 906, 906, _

906, 959, 959, 972, 972, 972, 972, 927, 927, 908, 908, 908, 908, 965, 965, 973, 973, 973, 973, _

973, 973, 933, 910, 910, 910, 969, 969, 974, 974, 974, 974, 974, 974, 937, 937, 911, 911, 911, _

911, 911, 911, 940, 940, 941, 941, 942, 942, 943, 943, 972, 972, 973, 973, 974, 974, 945, 945, _

940, 940, 940, 940, 940, 940, 913, 913, 902, 902, 902, 902, 902, 902, 951, 951, 942, 942, 942, _

942, 942, 942, 919, 919, 905, 905, 905, 905, 905, 905, 969, 969, 974, 974, 974, 974, 974, 974, _

937, 937, 911, 911, 911, 911, 911, 911, 940, 945, 940, 940, 940, 902, 902, 913, 942, 951, 942, _

942, 942, 904, 904, 905, 905, 919, 912, 912, 943, 912, 906, 906, 944, 944, 961, 961, 973, 944, _

910, 910, 929, 974, 969, 974, 974, 974, 908, 908, 911, 911, 937, 32, 900, 900, 900, 900, 900, 900, 900, 900, 32)

Application.ScreenUpdating = False

Set keimeno = Selection

For i = LBound(Polytonic) To UBound(Polytonic)

keimeno = Replace(keimeno, ChrW(Polytonic(i)), ChrW(Monotonic(i)))

Next

Selection.TypeText Text:=keimeno

Application.ScreenUpdating = True

End Sub

‘Κώδικας για το Excel:

Sub FromPolytonicToMonotonic()

'για Excel

'από το Excel Λύσεις

Dim keli As Range

Dim kelia As Range

Dim Polytonic As Variant

Dim Monotonic As Variant

Dim i As Integer

Polytonic = VBA.Array(976, 977, 978, 979, 980, 981, 982, 983, 1008, 1009, 1010, 1012, 1013, _

7936, 7937, 7938, 7939, 7940, 7941, 7942, 7943, 7944, 7945, 7946, 7947, 7948, 7949, 7950, _

7951, 7952, 7953, 7954, 7955, 7956, 7957, 7960, 7961, 7962, 7963, 7964, 7965, 7968, 7969, _

7970, 7971, 7972, 7973, 7974, 7975, 7976, 7977, 7978, 7979, 7980, 7981, 7982, 7983, 7984, _

7985, 7986, 7987, 7988, 7989, 7990, 7991, 7992, 7993, 7994, 7995, 7996, 7997, 7998, 7999, 8000, _

8001, 8002, 8003, 8004, 8005, 8008, 8009, 8010, 8011, 8012, 8013, 8016, 8017, 8018, 8019, 8020, _

8021, 8022, 8023, 8025, 8027, 8029, 8031, 8032, 8033, 8034, 8035, 8036, 8037, 8038, 8039, 8040, _

8041, 8042, 8043, 8044, 8045, 8046, 8047, 8048, 8049, 8050, 8051, 8052, 8053, 8054, 8055, 8056, _

8057, 8058, 8059, 8060, 8061, 8064, 8065, 8066, 8067, 8068, 8069, 8070, 8071, 8072, 8073, 8074, _

8075, 8076, 8077, 8078, 8079, 8080, 8081, 8082, 8083, 8084, 8085, 8086, 8087, 8088, 8089, 8090, _

8091, 8092, 8093, 8094, 8095, 8096, 8097, 8098, 8099, 8100, 8101, 8102, 8103, 8104, 8105, 8106, _

8107, 8108, 8109, 8110, 8111, 8114, 8115, 8116, 8118, 8119, 8122, 8123, 8124, 8130, 8131, 8132, _

8134, 8135, 8136, 8137, 8138, 8139, 8140, 8146, 8147, 8150, 8151, 8154, 8155, 8162, 8163, 8164, _

8165, 8166, 8167, 8170, 8171, 8172, 8178, 8179, 8180, 8182, 8183, 8184, 8185, 8186, 8187, 8188, _

8127, 8141, 8142, 8143, 8157, 8158, 8159, 8175, 8189, 8190)

Monotonic = VBA.Array(946, 952, 933, 910, 939, 966, 960, 38, 954, 961, 963, 920, 949, 945, 945, _

940, 940, 940, 940, 940, 940, 913, 913, 902, 902, 902, 902, 902, 902, 949, 949, 941, 941, 941, _

941, 917, 917, 904, 904, 904, 904, 951, 951, 942, 942, 942, 942, 942, 942, 919, 919, 905, 905, _

905, 905, 905, 905, 953, 953, 943, 943, 943, 943, 943, 943, 921, 921, 906, 906, 906, 906, 906, _

906, 959, 959, 972, 972, 972, 972, 927, 927, 908, 908, 908, 908, 965, 965, 973, 973, 973, 973, _

973, 973, 933, 910, 910, 910, 969, 969, 974, 974, 974, 974, 974, 974, 937, 937, 911, 911, 911, _

911, 911, 911, 940, 940, 941, 941, 942, 942, 943, 943, 972, 972, 973, 973, 974, 974, 945, 945, _

940, 940, 940, 940, 940, 940, 913, 913, 902, 902, 902, 902, 902, 902, 951, 951, 942, 942, 942, _

942, 942, 942, 919, 919, 905, 905, 905, 905, 905, 905, 969, 969, 974, 974, 974, 974, 974, 974, _

937, 937, 911, 911, 911, 911, 911, 911, 940, 945, 940, 940, 940, 902, 902, 913, 942, 951, 942, _

942, 942, 904, 904, 905, 905, 919, 912, 912, 943, 912, 906, 906, 944, 944, 961, 961, 973, 944, _

910, 910, 929, 974, 969, 974, 974, 974, 908, 908, 911, 911, 937, 32, 900, 900, 900, 900, 900, 900, 900, 900, 32)

Set kelia = Application.Intersect(ActiveSheet.UsedRange, Selection)

Application.ScreenUpdating = False

For Each keli In kelia

For i = LBound(Polytonic) To UBound(Polytonic)

keli = Replace(keli, ChrW(Polytonic(i)), ChrW(Monotonic(i)))

Next i

keli = keli.Value2

Next keli

Application.ScreenUpdating = True

End Sub

................
................

In order to avoid copyright disputes, this page is only a partial summary.

Google Online Preview   Download