API tools faq
paste
Advertisement
AlanElston

WotchaGot

AlanElston
Jul 27th, 2022
1,237
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
VisualBasic 16.25 KB | None | 0 0
raw download clone embed print report
  1. ' https://excelfox.com/forum/showthread.php/2302-quot-What%e2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=15524&viewfull=1#post15524
  2. Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String, Optional ByVal FlNme As String) '
  3. Rem 1  ' Output "sheet hardcopies"
  4. '1a) Worksheets     'Make Temporary Sheets, if not already there, in Current Active Workbook, for a simple list of all characters, and for pasting the string into worksheet cells
  5. '1a)(i) Full list of characters worksheet
  6.    If Not Evaluate("=ISREF(" & "'" & "WotchaGotInString" & "'!Z78)") Then '   ( the '  are not important here, but in general allow for a space in the worksheet name like  "Wotcha Got In String"
  7.    Dim Wb As Workbook '                                   ' ' Dim:  ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense )                     '
  8.     Set Wb = ActiveWorkbook '  '                            Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want...         Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191                                '
  9.     Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
  10.    Dim Ws As Worksheet '
  11.     Set Ws = ActiveSheet 'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want...    Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191            ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed.      http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
  12.     Ws.Activate: Ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
  13.     Let Ws.Name = "WotchaGotInString"
  14.     Else ' The worksheet is already there , so I just need to set my variable to point to it
  15.     Set Ws = ThisWorkbook.Worksheets("WotchaGotInString")
  16.     End If
  17. '1a(ii) Worksheet to paste out string into worksheet cells
  18.    If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
  19.      Set Wb = ActiveWorkbook
  20.      Wb.Worksheets.Add After:=Wb.Worksheets.Item(1)
  21.     Dim Ws1 As Worksheet
  22.      Set Ws1 = ActiveSheet
  23.      Ws1.Activate: Ws1.Cells(1, 1).Activate
  24.      Let Ws1.Name = "StrIn|WtchaGot"
  25.     Else
  26.      Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
  27.     End If
  28. '1b) Array
  29. Dim myLenf As Long: Let myLenf = Len(strIn)  '            ' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in.  '( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )       https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
  30. Dim arrWotchaGot() As String: ReDim arrWotchaGot(1 To myLenf + 1, 1 To 2) ' +1 for header  Array for the output 2 column list.  The type is known and the size,  but I must use this ReDim  method simply because the dim statement  Dim( , )  is complie time thing and will only take actual numbers
  31. Let arrWotchaGot(1, 1) = FlNme & vbLf & Format(Now, "DD MMM YYYY") & vbLf & "Lenf is   " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
  32. Rem 2  String anylaysis
  33. 'Dim myLenf As Long: Let myLenf = Len(strIn)
  34. Dim Cnt As Long
  35.     For Cnt = 1 To myLenf ' ===Main Loop========================================================================
  36.    ' Character analysis: Get at each character
  37.    Dim Caracter As Variant ' String is probably OK.
  38.    Let Caracter = Mid(strIn, Cnt, 1) ' '    the character in strIn at position from the left of length 1
  39.    '2a) The character added to a single  WotchaGot  long character string to look at and possibly use in coding
  40.    Dim WotchaGot As String ' This will be used to make a string that I can easilly see and also is in a form that I can copy and paste in a code line  required to build the full string of the complete character string
  41.        '2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
  42.        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Or Caracter = " " Then ' Check for normal characters
  43.            'SirNirios
  44.            If Not Cnt = 1 Then ' I am only intersted in next line comparing the character before, and if i did not do this the next line would error if first character was a  "normal"  character
  45.                If Not Cnt = myLenf And (Mid(strIn, Cnt - 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt - 1, 1) Like "[0-9]" Or Mid(strIn, Cnt - 1, 1) Like "[a-z]" Or Mid(strIn, Cnt - 1, 1) Like " ") Then   ' And (Mid(strIn, Cnt + 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt + 1, 1) Like "[0-9]" Or Mid(strIn, Cnt + 1, 1) Like "[a-z]") Then
  46.                 Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
  47.                 Else
  48.                 End If
  49.             Else
  50.             End If
  51.         Let WotchaGot = WotchaGot & """" & Caracter & """" & " & " ' This will give the sort of output that I need to write in a code line, so for example if I have a123 , this code line will be used 4 times and give like a final string for me to copy of   "a" & "1" & "2" & "3" &      I would phsically need to write in code  like  strVar = "a" & "1" & "2" & "3"   -  i could of course also write  = "a123"   but the point of this routine is to help me pick out each individual element
  52.        Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf  vbTab
  53.         Select Case Caracter ' 2a)(ii)_1
  54.          Case " "
  55.            Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  56.           Case "!"
  57.            Let WotchaGot = WotchaGot & """" & "!" & """" & " & "
  58.           Case "$"
  59.            Let WotchaGot = WotchaGot & """" & "$" & """" & " & "
  60.           Case "%"
  61.            Let WotchaGot = WotchaGot & """" & "%" & """" & " & "
  62.           Case "~"
  63.            Let WotchaGot = WotchaGot & """" & "~" & """" & " & "
  64.           Case "&"
  65.            Let WotchaGot = WotchaGot & """" & "&" & """" & " & "
  66.           Case "("
  67.            Let WotchaGot = WotchaGot & """" & "(" & """" & " & "
  68.           Case ")"
  69.            Let WotchaGot = WotchaGot & """" & ")" & """" & " & "
  70.           Case "/"
  71.            Let WotchaGot = WotchaGot & """" & "/" & """" & " & "
  72.           Case "\"
  73.            Let WotchaGot = WotchaGot & """" & "\" & """" & " & "
  74.           Case "="
  75.            Let WotchaGot = WotchaGot & """" & "=" & """" & " & "
  76.           Case "?"
  77.            Let WotchaGot = WotchaGot & """" & "?" & """" & " & "
  78.           Case "'"
  79.            Let WotchaGot = WotchaGot & """" & "'" & """" & " & "
  80.           Case "+"
  81.            Let WotchaGot = WotchaGot & """" & "+" & """" & " & "
  82.           Case "-"
  83.            Let WotchaGot = WotchaGot & """" & "-" & """" & " & "
  84.           Case "_"
  85.            Let WotchaGot = WotchaGot & """" & "_" & """" & " & "
  86.           Case "."
  87.            Let WotchaGot = WotchaGot & """" & "." & """" & " & "
  88.           Case ","
  89.            Let WotchaGot = WotchaGot & """" & "," & """" & " & "
  90.           Case ";"
  91.            Let WotchaGot = WotchaGot & """" & ";" & """" & " & "
  92.           Case ":"
  93.            Let WotchaGot = WotchaGot & """" & ":" & """" & " & "
  94.           Case "#"
  95.            Let WotchaGot = WotchaGot & """" & "#" & """" & " & "
  96.           Case "@"
  97.            Let WotchaGot = WotchaGot & """" & "@" & """" & " & "
  98. '          Case " "
  99. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  100. '          Case " "
  101. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  102. '          Case " "
  103. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  104. '          Case " "
  105. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  106. '          Case " "
  107. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  108. '          Case " "
  109. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  110. '          Case " "
  111. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  112. '          Case " "
  113. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  114. '          Case " "
  115. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  116. '          Case " "
  117. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  118. '                   ' 2a)(ii)_2
  119. '          Case " "
  120. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  121. '          Case " "
  122. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  123.          Case vbCr
  124.            Let WotchaGot = WotchaGot & "vbCr & "  ' I actuall would write manually in this case like     vbCr &
  125.          Case vbLf
  126.            Let WotchaGot = WotchaGot & "vbLf & "
  127.           Case vbCrLf
  128.            Let WotchaGot = WotchaGot & "vbCrLf & "
  129.           Case vbNewLine
  130.            Let WotchaGot = WotchaGot & "vbNewLine & "
  131.           Case """"   ' This is how to get a single   "    No one is quite sure how this works.  My theory that,  is as good as any other,  is that  syntaxly   """"    or  "  """  or    """    "   are accepted.   But  in that the  """  bit is somewhat strange for VBA.   It seems to match  the first and Third " together as a  valid pair   but  the other  " in the middle of the  3 "s is also syntax OK, and does not error as    """     would  because  of the final 4th " which it syntaxly sees as a valid pair matched simultaneously as it does some similar check on the  first  and Third    as a concluding  string pair.  All is well except that  the second  "  is captured   within a   accepted  enclosing pair made up of the first and third  "   At the same time the 4th  "  is accepted as a final concluding   "   paired with the   second which it is  using but at the same time now isolated from.
  132.           Let WotchaGot = WotchaGot & """" & """" & """" & """" & " & "                                ' The reason why  ""  ""   would not work is that    at the end of the  "" the next empty  character signalises the end of a  string pair, and only if  it saw a " would it keep checking the syntax rules which  then lead in the previous case to  the situation described above.
  133.          Case vbTab
  134.            Let WotchaGot = WotchaGot & "vbTab & "
  135.           ' 2a)(iii)
  136.            Case Else
  137.                 If AscW(Caracter) < 256 Then
  138.                  Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
  139.                 Else
  140.                  Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
  141.                 End If
  142.             'Let CaseElse = Caracter
  143.        End Select
  144.         End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
  145.    '2b)  A 2 column Array for convenience of a list
  146.     Let arrWotchaGot(Cnt + 1, 1) = Cnt & "           " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
  147.    Next Cnt ' ========Main Loop=================================================================================
  148.    '2c) Some tidying up
  149.    If WotchaGot <> "" Then
  150.      Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "    ( 2 spaces one either side of a  & )
  151.     Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
  152.         If Len(strIn) = 1 Then
  153.        
  154.         Else
  155.             ' The next bit changes like this  "Lapto" & "p"  to  "Laptop"   You might want to leave it out ti speed things up a bit
  156.               If Len(WotchaGot) > 5 And (Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[a-z]") And (Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[a-z]") And Mid(WotchaGot, Len(WotchaGot) - 6, 5) = """" & " & " & """" Then
  157.                 Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) '  Changes like this  "Lapto" & "p"  to  "Laptop"
  158.               Else
  159.                End If
  160.         End If
  161.     Else
  162.     End If
  163. Rem 3 Output
  164. '3a) String
  165. '3a)(i)
  166. MsgBox prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
  167. '3a)(ii)
  168. Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
  169. Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count).End(xlUp).Row     '   http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466      Making Lr dynamic ( using rng.End(XlUp) for a single column. )
  170. Let Ws1.Range("A" & Lr1 + 1 & "").Value = FlNme
  171.  Let Ws1.Range("B" & Lr1 + 1 & "").Value = strIn
  172.  Let Ws1.Range("C" & Lr1 + 1 & "").Value = WotchaGot
  173.  Ws1.Cells.Columns.AutoFit
  174. '3b) List
  175. Dim NxtClm As Long: Let NxtClm = 1 ' In conjunction with next  If  this prevents the first column beine taken as 0 for an empty worksheet
  176. Ws.Activate: Ws.Cells.Item(1, 1).Activate
  177.  If Not Ws.Range("A1").Value = "" Then Let NxtClm = Ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
  178.  Let Ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
  179.  Ws.Cells.Columns.AutoFit
  180. '3c) Output  WotchaGot  string to a text file
  181. '3c)(i) Simple string
  182. Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
  183. Dim PathAndFileName2 As String
  184.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & ".txt" ' CHANGE path TO SUIT
  185. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  186. Print #FileNum2, WotchaGot ' write out entire text file
  187. Close #FileNum2
  188. '3c)(ii) Introduce an  "invisible"  vbCr & vbLf  pair after each  seen pair within  the string. this will give actual lines in the text file
  189. Let WotchaGot = Replace(WotchaGot, "vbCr & vbLf & ", "vbCr & vbLf" & vbCr & vbLf, 1, -1, vbBinaryCompare)
  190.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & "_inLines.txt" ' CHANGE path TO SUIT
  191. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  192. Print #FileNum2, WotchaGot ' write out entire text file
  193. Close #FileNum2
  194.  '3c(iii) Number the new introduced actual Liners in the text file
  195. Dim arrIt() As String: Let arrIt() = Split(WotchaGot, vbCr & vbLf, -1, vbBinaryCompare)
  196.  Let WotchaGot = ""
  197.     For Cnt = 0 To UBound(arrIt())
  198.      Let WotchaGot = WotchaGot & Cnt & " " & arrIt(Cnt) & vbCr & vbLf
  199.     Next Cnt
  200.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & "_inNumberedLines.txt" ' CHANGE path TO SUIT
  201. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  202. Print #FileNum2, WotchaGot ' write out entire text file
  203. Close #FileNum2
  204.  
  205. End Sub
  206.  
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!