Oscar Sun

                    Sub 由字碼插入自行造字區之造字()
Dim i As Integer,rng as Range
Set rng=Selection.Range
For i = -8192 To -4633 '-7688
    Selection.TypeText Hex(i) '十進位轉十六位進位（16進位） https://docs.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/hex-function
    Selection.ToggleCharacterCode
    rng.SetRange Selection.Start - 1, Selection.End
    rng.Font.Name = "EUDC"
Next i
End Sub
                  

                    using System;

namespace Guess {
    class Guess {
        int a, b, times;
        string answer;
        public int A { get => a; set => a = value; }
        public int B { get => b; set => b = value; }
        public int Times { get => times; set => times = value; }
        public string Answer { get => answer; set => answer = value; }
        public Guess (int digit = 4) {
            string numbers = "1234567890";
            while (true) {
                answer = shuffle (numbers).Substring (0, digit);
                if (answer[0] != '0') {
                    break;
                }
            }
            a = 0;
            b = 0;
            times = 0;
        }
        string shuffle (string s) {
            char[] s_array = s.ToCharArray ();
            Random r = new Random ();
            int i = s.Length;
            while (i > 0) {
                int n = r.Next (i);
                char v = s_array[n];
                s_array[n] = s_array[--i];
                s_array[i] = v;
            }
            return new string (s_array);
        }
        bool findNumber (string number) {
            int i = 0;
            string ss = number.Substring (++i);
            foreach (char c in number) {
                foreach (char cc in ss) {
                    if (cc == c)
                        return true;
                }
                if (i == number.Length)
                    return false;
                ss = number.Substring (++i);
            }
            return false;
        }
        void abCounter (string guess) {
            //a:記下猜對之數，b：猜錯幾次
            foreach (char g in guess) {
                if (answer.Contains (g) && //因為數字不能重複，才能只用IndexOf方法判斷
                    answer.IndexOf (g) == guess.IndexOf (g)) {
                    a++;
                } else
                    b++;
            }

        }
        public void run () {
            string guess = "";
            Guess game = new Guess (); //預設是4位數
            while (true) {
                Console.WriteLine ("請輸入您猜的4位數的答案。" +
                    "  提示：數字不能重複。");
                guess = Console.ReadLine ();
                while (guess.Length > 4) {
                    Console.WriteLine ("所給的數字長度太長，只能是4個數字" +
                        "請重新輸入：");
                    guess = Console.ReadLine ();
                }
                while (game.findNumber (guess)) {
                    Console.WriteLine ("所給數字有重複！請重新輸入...");
                    guess = Console.ReadLine ();
                }
                //開始將guess與answer比對
                game.abCounter (guess);
                if (game.A > 0) {
                    Console.WriteLine ("答對{0}個數字，答錯{1}個。Ans.{2}", 
                        game.A, game.B,game.Answer);
                    break;
                } else
                    Console.WriteLine ("猜錯了，請繼續猜...Ans.{0}", game.Answer);
                game.A = 0;
                game.B = 0;
            }

        }

    }
    class Program {
        static void Main (string[] args) {
            Guess game = new Guess ();
            game.run ();
        }
    }
}
                  

                    using System;
using RemoveDuplicateChar;

namespace EncryptNamespace {
    class EncryptNamespace {
        readonly string _letter = "abcdefghijklmnopqrstuvwxyz"; //字母表
        string _code; //class內的成員沒有寫存取修飾詞，預設都是private
        public bool CodeTableOK = false; //記錄所提供的編碼表密碼表是否正確
        public string Code {
            get { return _code; }
            set {                
                //如果不夠長，又不是字串
                if (value.Length < 26 || value.GetType ().Name != "String") 
                    Console.WriteLine ("密碼表設定有誤，必須是剛好26字元長，且不可有重複的字元。");
                else if (RemoveDuplicateCharProgram.main(value) == true)
                        Console.WriteLine ("所提供的密碼表字元有重複！");
                else {
                    _code = value;
                    CodeTableOK = true;
                }
            }
        }
        public EncryptNamespace () {
            Shuffle (_letter);
        }
        public EncryptNamespace (string codeStr) {
            Code = codeStr;
        }
        void Shuffle (string s) {
            Random r = new Random ();
            char[] s_array = s.ToCharArray ();
            int s_lenght = s.Length;
            while (s_lenght > 0) {
                int i = r.Next (s_lenght);
                char a = s_array[i];
                s_array[i] = s_array[--s_lenght];
                s_array[s_lenght] = a;
            }
            _code = new String (s_array);
        }

        public string ToEncode (string s) {
            string result = "";
            for (int i = 0; i < s.Length; i++) {
                if (_letter.Contains (s[i])) {
                    result += _code[_letter.IndexOf (s[i])];
                } else {
                    result += s[i];
                }
            }
            return result;
        }
        public string ToDecode (string s) {
            string result = "";
            for (int i = 0; i < s.Length; i++) {
                if (_code.Contains (s[i])) {
                    result += _letter[_code.IndexOf (s[i])];
                } else
                    result += s[i];
            }
            return result;
        }

    }
    class Program {
        static void Main (string[] args) {
            // string toCode = new string ("Good Boys");
            Console.WriteLine ("請輸入要編碼的字串：");
            string toCode = new string (Console.ReadLine ());
            EncryptNamespace e = new EncryptNamespace ();
            string Encoded = e.ToEncode (toCode);
            Console.WriteLine ("現在的密碼表是：{0}", e.Code);
            Console.WriteLine ("現在要編碼的是：{0}", toCode);
            Console.WriteLine ("現在已編碼為：{0}", Encoded);
            Console.WriteLine ("現在解碼的結果是：{0}", e.ToDecode (Encoded));
            Console.WriteLine ("請輸入密碼表：");
            EncryptNamespace E = new EncryptNamespace (Console.ReadLine ());
            if (E.CodeTableOK) {
                Console.WriteLine ("請輸入要編碼的字串：");
                toCode = Console.ReadLine ();
                Encoded = E.ToEncode (toCode);
                Console.WriteLine ("現在的密碼表是：{0}", E.Code);
                Console.WriteLine ("現在要編碼的是：{0}", toCode);
                Console.WriteLine ("現在已編碼為：{0}", Encoded);
                Console.WriteLine ("現在解碼的結果是：{0}", E.ToDecode (Encoded));
            }
        }
    }
}

using System;

namespace RemoveDuplicateChar {
    class RemoveDuplicateCharProgram {
        public static bool main (string s) {
            // Console.WriteLine ("請輸入要檢查重覆的字串：");
            // string s = Console.ReadLine ();
            char[] c = new char[s.Length];
            int i = 0;
            bool dupli = false;
            foreach (char item in s) {
                if (Array.IndexOf (c, item) < 0) {
                    c[i++] = item;
                } else {
                    c[i++] = '\0';
                    dupli = true;
                }
            }
            if (dupli) {
                Console.WriteLine ("有重複！汰重後的結果：{0}",
                    new String (c));
                return true;
            } else {
                // Console.WriteLine ("沒有重複!");
                return false;
            }
        }
    }
}
                  

                    Sub 選取區文字之構詞組詞列出() 'Alt+c
Dim chars As String, vocabularyWord As String, i As Byte, L As Byte, dbf As String, vocabulary As String, j As Byte 'https://www.hopenglish.com/hope-tips-should-we-say-vocabularyWord-or-vocabularies
Dim rng As Range, s As Long, e As Long
Dim cnt As New ADODB.Connection, rst As New ADODB.Recordset
Dim IsColor As Boolean
If MsgBox("是否要將個個字標上不同顏色，以便識別？", vbOKCancel) = vbOK Then IsColor = True
chars = Selection.Text
s = Selection.Start
dbf = system.SearchPath & "\Macros\《重編國語辭典修訂本》資料庫.mdb"
cnt.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & dbf
'《國語辭典》與黃老師編遠東詞典收詞集合：
rst.Open "select 詞 from 詞 order by len(詞),常用等級 desc,詞", cnt ', adOpenKeyset, adLockOptimistic
Do Until rst.EOF
    vocabularyWord = rst.Fields("詞").Value
    L = Len(vocabularyWord)
    For i = 1 To L
        If InStr(chars, Mid(vocabularyWord, i, 1)) = 0 Then
            Exit For
        Else
            j = j + 1
        End If
    Next i
    If j = L Then vocabulary = vocabulary & vocabularyWord & "、"
    j = 0
    rst.MoveNext
Loop
vocabulary = Mid(vocabulary, 1, Len(vocabulary) - 1)
Selection.InsertParagraphAfter
Selection.Collapse wdCollapseEnd
Selection.Font.Color = 12611584
Selection.InsertAfter vocabulary & Chr(13)
If IsColor Then
    Randomize 'https://docs.microsoft.com/zh-tw/office/vba/language/reference/user-interface-help/randomize-statement?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.query%3FappId%3DDev11IDEF1%26l%3Dzh-TW%26k%3Dk(vblr6.chm1008998)%3Bk(TargetFrameworkMoniker-Office.Version%3Dv16)%26rd%3Dtrue
    Set rng = Selection.Range
    rng.SetRange s, rng.End
    For e = 1 To Len(chars)
        With rng.Find
            .Replacement.Font.Color = RGB(Int((255 * Rnd) + 1), Int((255 * Rnd) + 1), Int((255 * Rnd) + 1))
            .Execute Mid(chars, e, 1), , , , , , , , , Mid(chars, e, 1), wdReplaceAll
        End With
    Next e
End If
rst.Close: cnt.Close
End Sub


                  

                    Option Explicit

Sub test()
Dim rng As Range, c, b, st, i As Long, j As Long, rw, flg As Boolean, r
Dim buyer() As String
Dim buyerCnt() As Long
Set rng = ActiveSheet.UsedRange
rw = 1
ReDim Preserve buyer(0)
ReDim Preserve buyerCnt(0)
For Each c In rng.Columns(5).Cells
    If c <= VBA.Replace(VBA.Date, "/", "") Then
        buyer(0) = rng.Cells(c.Row, 1)
        Exit For
    End If
Next c
buyerCnt(0) = 1
For Each c In rng.Columns(1).Cells
    If rw > 2 Then
'    If c = "同事" Then Stop
        For Each b In buyer
            If VBA.StrComp(c, b) = 0 Then
                buyerCnt(j) = buyerCnt(j) + 1
                flg = True
                Exit For
            End If
            j = j + 1
        Next b
        j = 0
        If Not flg Then
            i = i + 1
            ReDim Preserve buyer(i)
            ReDim Preserve buyerCnt(i)
            buyer(i) = c.Value
            buyerCnt(i) = 1
        End If
        flg = False
    End If
    rw = rw + 1
Next c
'取得購買者購買量（以上）
'陣列排序：
rw = UBound(buyerCnt)
reOrder:
For i = 0 To rw - 1
    If buyerCnt(i) < buyerCnt(i + 1) Then
        c = buyerCnt(i)
        b = buyerCnt(i + 1)
        buyerCnt(i) = b
        buyerCnt(i + 1) = c
        c = buyer(i)
        b = buyer(i + 1)
        buyer(i) = b
        buyer(i + 1) = c
    End If
Next i
For i = 0 To rw - 1
        If buyerCnt(i) < buyerCnt(i + 1) Then
            GoTo reOrder
        End If
Next i
'找出前3名：
j = 0
For i = 0 To rw - 1
    If buyerCnt(i) > buyerCnt(i + 1) Then j = j + 1
    If j = 3 Then
        c = i '記下要列出幾個購買者
        Exit For
    End If
Next i
flg = False
For i = 0 To c
rep:
    For Each b In rng.Columns(1).Cells
        If b.Value = buyer(i) Then '列出前3名的購買者明細
            If rng.Rows(b.Row).Cells(5) <= VBA.Replace(VBA.Date, "/", "") Then
                For Each st In ActiveWorkbook.Sheets '若沒有工作表則新增
                    If st.Name = buyer(i) Then
                        flg = True
                        Exit For
                    End If
                Next
                If flg = False Then
                    Set st = ActiveWorkbook.Sheets.Add
                    st.Name = buyer(i)
                    For j = 1 To rng.Rows(b.Row).Cells.Count
                        st.Rows(1).Cells(j) = rng.Rows(1).Cells(j)
                    Next
                Else
                    flg = False
                End If
                If r = 0 Then
                    r = st.UsedRange.Rows.Count + 1
                Else
                    r = r + 1
                End If
                Set rw = st.Rows(r)
                For j = 1 To rng.Rows(b.Row).Cells.Count
                    rw.Cells(j) = rng.Rows(b.Row).Cells(j)
                Next
                rng.Rows(b.Row).Delete
                GoTo rep
            End If
        End If
    Next b
    r = 0
Next i
End Sub