AlanElston

Untitled

Apr 16th, 2021
645
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  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
  2. ' 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=11015&viewfull=1#post11015
  3. ' http://www.eileenslounge.com/viewtopic.php?f=30&t=35732&p=278061#p278061
  4. Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String, Optional ByVal FlNme As String) '
  5. Rem 1  ' Output "sheet hardcopies"
  6. '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
  7. '1a)(i) Full list of characters worksheet
  8.    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"
  9.    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 )                     '
  10.     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                                '
  11.     Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
  12.    Dim Ws As Worksheet '
  13.     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
  14.     Ws.Activate: Ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
  15.     Let Ws.Name = "WotchaGotInString"
  16.     Else ' The worksheet is already there , so I just need to set my variable to point to it
  17.     Set Ws = ThisWorkbook.Worksheets("WotchaGotInString")
  18.     End If
  19. '1a(ii) Worksheet to paste out string into worksheet cells
  20.    If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
  21.      Set Wb = ActiveWorkbook
  22.      Wb.Worksheets.Add After:=Wb.Worksheets.Item(1)
  23.     Dim Ws1 As Worksheet
  24.      Set Ws1 = ActiveSheet
  25.      Ws1.Activate: Ws1.Cells(1, 1).Activate
  26.      Let Ws1.Name = "StrIn|WtchaGot"
  27.     Else
  28.      Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
  29.     End If
  30. '1b) Array
  31. 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
  32. 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
  33. Let arrWotchaGot(1, 1) = FlNme & vbLf & Format(Now, "DD MMM YYYY") & vbLf & "Lenf is   " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
  34. Rem 2  String anylaysis
  35. 'Dim myLenf As Long: Let myLenf = Len(strIn)
  36. Dim Cnt As Long
  37.     For Cnt = 1 To myLenf ' ===Main Loop========================================================================
  38.    ' Character analysis: Get at each character
  39.    Dim Caracter As Variant ' String is probably OK.
  40.    Let Caracter = Mid(strIn, Cnt, 1) ' '    the character in strIn at position from the left of length 1
  41.    '2a) The character added to a single  WotchaGot  long character string to look at and possibly use in coding
  42.    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
  43.        '2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
  44.        If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Or Caracter = " " Then ' Check for normal characters
  45.            'SirNirios
  46.            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
  47.                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
  48.                 Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
  49.                 Else
  50.                 End If
  51.             Else
  52.             End If
  53.         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
  54.        Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf  vbTab
  55.         Select Case Caracter ' 2a)(ii)_1
  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. '          Case " "
  119. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  120. '                   ' 2a)(ii)_2
  121. '          Case " "
  122. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  123. '          Case " "
  124. '           Let WotchaGot = WotchaGot & """" & " " & """" & " & "
  125.          Case vbCr
  126.            Let WotchaGot = WotchaGot & "vbCr & "  ' I actuall would write manually in this case like     vbCr &
  127.          Case vbLf
  128.            Let WotchaGot = WotchaGot & "vbLf & "
  129.           Case vbCrLf
  130.            Let WotchaGot = WotchaGot & "vbCrLf & "
  131.           Case vbNewLine
  132.            Let WotchaGot = WotchaGot & "vbNewLine & "
  133.           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.
  134.           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.
  135.          Case vbTab
  136.            Let WotchaGot = WotchaGot & "vbTab & "
  137.           ' 2a)(iii)
  138.            Case Else
  139.                 If AscW(Caracter) < 256 Then
  140.                  Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
  141.                 Else
  142.                  Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
  143.                 End If
  144.             'Let CaseElse = Caracter
  145.        End Select
  146.         End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
  147.    '2b)  A 2 column Array for convenience of a list
  148.     Let arrWotchaGot(Cnt + 1, 1) = Cnt & "           " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
  149.    Next Cnt ' ========Main Loop=================================================================================
  150.    '2c) Some tidying up
  151.    If WotchaGot <> "" Then
  152.      Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & "    ( 2 spaces one either side of a  & )
  153.     Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
  154.      ' The next bit changes like this  "Lapto" & "p"  to  "Laptop"   You might want to leave it out ti speed things up a bit
  155.        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
  156.          Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) '  Changes like this  "Lapto" & "p"  to  "Laptop"
  157.        Else
  158.         End If
  159.     Else
  160.     End If
  161. Rem 3 Output
  162. '3a) String
  163. '3a)(i)
  164. MsgBox prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
  165. '3a)(ii)
  166. Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
  167. 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. )
  168. Let Ws1.Range("A" & Lr1 + 1 & "").Value = FlNme
  169.  Let Ws1.Range("B" & Lr1 + 1 & "").Value = strIn
  170.  Let Ws1.Range("C" & Lr1 + 1 & "").Value = WotchaGot
  171.  Ws1.Cells.Columns.AutoFit
  172. '3b) List
  173. 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
  174. Ws.Activate: Ws.Cells.Item(1, 1).Activate
  175.  If Not Ws.Range("A1").Value = "" Then Let NxtClm = Ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
  176.  Let Ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
  177.  Ws.Cells.Columns.AutoFit
  178. '3c) Output  WotchaGot  string to a text file
  179. '3c)(i) Simple string
  180. Dim FileNum2 As Long: Let FileNum2 = FreeFile(0)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
  181. Dim PathAndFileName2 As String
  182.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & ".txt" ' CHANGE path TO SUIT
  183. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  184. Print #FileNum2, WotchaGot ' write out entire text file
  185. Close #FileNum2
  186. '3c)(ii) Introduce an  "invisible"  vbCr & vbLf  pair after each  seen pair within  the string. this will give actual lines in the text file
  187. Let WotchaGot = Replace(WotchaGot, "vbCr & vbLf & ", "vbCr & vbLf" & vbCr & vbLf, 1, -1, vbBinaryCompare)
  188.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & "_inLines.txt" ' CHANGE path TO SUIT
  189. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  190. Print #FileNum2, WotchaGot ' write out entire text file
  191. Close #FileNum2
  192.  '3c(iii) Number the new introduced actual Liners in the text file
  193. Dim arrIt() As String: Let arrIt() = Split(WotchaGot, vbCr & vbLf, -1, vbBinaryCompare)
  194.  Let WotchaGot = ""
  195.     For Cnt = 0 To UBound(arrIt())
  196.      Let WotchaGot = WotchaGot & Cnt & " " & arrIt(Cnt) & vbCr & vbLf
  197.     Next Cnt
  198.  Let PathAndFileName2 = ThisWorkbook.Path & "\" & "WotchaGot_in_" & Replace(FlNme, ".txt", "", 1, 1, vbBinaryCompare) & "_inNumberedLines.txt" ' CHANGE path TO SUIT
  199. Open PathAndFileName2 For Output As #FileNum2 ' CHANGE TO SUIT  ' Will be made if not there
  200. Print #FileNum2, WotchaGot ' write out entire text file
  201. Close #FileNum2
  202.  
  203. End Sub
RAW Paste Data

Adblocker detected! Please consider disabling it...

We've detected AdBlock Plus or some other adblocking software preventing Pastebin.com from fully loading.

We don't have any obnoxious sound, or popup ads, we actively block these annoying types of ads!

Please add Pastebin.com to your ad blocker whitelist or disable your adblocking software.

×