Senin, 22 Agustus 2016

Re: [MS_AccessPros] Need to know how many of each digit in a series of unit numbers.

 

Hi Liz,

fun -- actually I did :) I modified my Code Documenter to make web pages for code snippets and have been going through my code libraries  -- and I just put the character count code into a database to document so the practical application for it will also get posted :)  Now I am over-hauling my website to update it for HTML5 and small devices whilst still looking good in an old browser.

thanks, Liz

respectfully,
crystal

~ have an awesome day ~

On 8/22/2016 5:24 PM, Liz Ravenwood liz_ravenwood@beaerospace.com [MS_Access_Professionals] wrote:

Cool piece of code Crystal.  I bet you had fun writing it.  J

 

From: MS_Access_Professionals@yahoogroups.com [mailto:MS_Access_Professionals@yahoogroups.com]
Sent: Monday, August 22, 2016 3:06 PM
To: MS_Access_Professionals@yahoogroups.com
Subject: Re: [MS_AccessPros] Need to know how many of each digit in a series of unit numbers.

 




Hi Doyce,

I used another way to count characters -- also wrote a function to loop through the records of a table in a field and count digits ... and the first program is to run it. Just change your tablename and fieldname :) 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ START CODE
Sub runHowManyOfEachDigit()
   Dim sTablename As String _
   , sFieldname As String
   sTablename = "MyTablename" '----- customize
   sFieldname = "MyFieldname" '----- customize
   Call HowManyOfEachDigit(sTablename, sFieldname)
End Sub

Public Sub HowManyOfEachDigit( _
   psTablename As String _
   , psFieldname As String)
'loop through the records of a table in a field
'and count occurrences of each digit
'for instance: to buy sign letters
's4p 160822
   On Error GoTo Proc_Err
  
   Dim db As DAO.Database _
      , rs As DAO.Recordset
     
   Dim sSQL As String _
      , sMsg As String _
      , i As Integer _
      , j As Integer _
      , s2Check As String _
      , nRecords As Long
     
   Dim asDigit(0 To 9) As String * 1
   Dim anNumberOf(0 To 9) As Long
  
   'assign values to asDigit and anNumberOf
   i = 0
   For j = 48 To 57
      asDigit(i) = Chr(j)
      anNumberOf(i) = 0
      i = i + 1
   Next j
  
   Set db = CurrentDb
  
   sSQL = "SELECT [" & psFieldname & "] as TheField" _
      & " FROM [" & psTablename & "]" _
      & " WHERE not ([" & psFieldname & "]) Is Null" _
      & ";"
   Set db = CurrentDb
   Set rs = db.OpenRecordset(sSQL, dbOpenSnapshot)
  
   nRecords = 0
  
   With rs
      Do While Not .EOF
         nRecords = nRecords + 1
         s2Check = !TheField
   Debug.Print s2Check
         For i = LBound(asDigit) To UBound(asDigit)
            anNumberOf(i) = anNumberOf(i) + Get_CountChar(s2Check, asDigit(i))
         Next i
         'goto next record
         .MoveNext
      Loop
      .Close
   End With
   Set rs = Nothing
   Set db = Nothing
   sMsg = "Number of each digit from " & Format(nRecords, "#,##0") & " records:"
  
   For i = LBound(asDigit) To UBound(asDigit)
      sMsg = sMsg & vbCrLf & asDigit(i) & Space(3) & anNumberOf(i)
   Next i
  
   'write to debug window and give user a message
   Debug.Print sMsg
   MsgBox sMsg, , "Done"
 
Proc_Exit:
   On Error Resume Next
   'release object variables
   If Not rs Is Nothing Then
      rs.Close
      Set rs = Nothing
   End If
   Set db = Nothing
   Exit Sub
 
Proc_Err:
   MsgBox Err.Description, , _
        "ERROR " & Err.Number _
        & "   HowManyOfEachDigit "

   Resume Proc_Exit
   ' Ctrl-Break the MsgBox... then Debug
   ' then set Resume to be the next statement by right-clicking on it
   ' and choosing Set Next Statement from the shortcut menu
   ' Press F8 to step through code one line at a time to see what is wrong
   Resume
End Sub

'~~~~~~~~~~~~~~~~~
Public Function Get_CountChar(pvString2Search As Variant, psCharSearchFor As String)
'strive4peace
   On Error GoTo Proc_Err
   
   'initialize return value
   Get_CountChar = 0
   If IsNull(pvString2Search) Then Exit Function
  
   Get_CountChar = UBound(Split(pvString2Search, psCharSearchFor))
  
Proc_Exit:
   On Error Resume Next
   Exit Function
 
Proc_Err:
   Resume Proc_Exit
End Function

'~~~~~~~~~~~~~~~~~
Public Function Get_CountWord(pvString2Search As Variant, psSearchFor As String) As Integer
'160819 strive4peace
   On Error GoTo Proc_Err
   
   'initialize return value
   Get_CountWord = 0
  
   If IsNull(pvString2Search) Then Exit Function
  
   'dimension variable
   Dim nPos As Long
  
   'initialize variable
   nPos = 0
  
   'count number of occurrences
   Do While True
      nPos = InStr(nPos + 1, pvString2Search, psSearchFor)
      If nPos = 0 Then Exit Function
      Get_CountWord = Get_CountWord + 1
   Loop
   
Proc_Exit:
   On Error Resume Next
   Exit Function
 
Proc_Err:
   Resume Proc_Exit
End Function

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ END CODE

respectfully,
crystal

~ have an awesome day ~

On 8/22/2016 8:03 AM, winberry.doyce@con-way.com [MS_Access_Professionals] wrote:

Good morning John,

For what I'm trying to do, your solution works fine. I was playing with this function and it was giving me the numbers I want in debug.print but I didn't know how to get them back to the query. I used the value of 3 because each trailer has the unit number on it in 3 places.

 

Public Function CountDigits(UNITID As String)
    Dim D1 As Integer
    Dim D2 As Integer
    Dim D3 As Integer
    Dim D4 As Integer
    Dim D5 As Integer
    Dim TL0 As Integer
    Dim TL1 As Integer
    Dim TL2 As Integer
    Dim TL3 As Integer
    Dim TL4 As Integer
    Dim TL5 As Integer
    Dim TL6 As Integer
    Dim TL7 As Integer
    Dim TL8 As Integer
    Dim TL9 As Integer

    D1 = Left(UNITID, 1)
    D2 = Mid(UNITID, 2, 1)
    D3 = Mid(UNITID, 3, 1)
    D4 = Mid(UNITID, 4, 1)
    D5 = Mid(UNITID, 5, 1)

    TL0 = 0
    TL1 = 0
    TL2 = 0
    TL3 = 0
    TL4 = 0
    TL5 = 0
    TL6 = 0
    TL7 = 0
    TL8 = 0
    TL9 = 0


    Select Case D1
    Case 0
        TL0 = TL0 + 3
    Case 1
        TL1 = TL1 + 3
    Case 2
        TL2 = TL2 + 3
    Case 3
        TL3 = TL3 + 3
    Case 4
        TL4 = TL4 + 3
    Case 5
        TL5 = TL5 + 3
    Case 6
        TL6 = TL6 + 3
    Case 7
        TL7 = TL7 + 3
    Case 8
        TL8 = TL8 + 3
    Case 9
        TL9 = TL9 + 3
    End Select
   
    Select Case D2
    Case 0
        TL0 = TL0 + 3
    Case 1
        TL1 = TL1 + 3
    Case 2
        TL2 = TL2 + 3
    Case 3
        TL3 = TL3 + 3
    Case 4
        TL4 = TL4 + 3
    Case 5
        TL5 = TL5 + 3
    Case 6
        TL6 = TL6 + 3
    Case 7
        TL7 = TL7 + 3
    Case 8
        TL8 = TL8 + 3
    Case 9
        TL9 = TL9 + 3
    End Select
       
    Select Case D3
    Case 0
        TL0 = TL0 + 3
    Case 1
        TL1 = TL1 + 3
    Case 2
        TL2 = TL2 + 3
    Case 3
        TL3 = TL3 + 3
    Case 4
        TL4 = TL4 + 3
    Case 5
        TL5 = TL5 + 3
    Case 6
        TL6 = TL6 + 3
    Case 7
        TL7 = TL7 + 3
    Case 8
        TL8 = TL8 + 3
    Case 9
        TL9 = TL9 + 3
    End Select
   
    Select Case D4
    Case 0
        TL0 = TL0 + 3
    Case 1
        TL1 = TL1 + 3
    Case 2
        TL2 = TL2 + 3
    Case 3
        TL3 = TL3 + 3
    Case 4
        TL4 = TL4 + 3
    Case 5
        TL5 = TL5 + 3
    Case 6
        TL6 = TL6 + 3
    Case 7
        TL7 = TL7 + 3
    Case 8
        TL8 = TL8 + 3
    Case 9
        TL9 = TL9 + 3
    End Select
   
    Select Case D5
    Case 0
        TL0 = TL0 + 3
    Case 1
        TL1 = TL1 + 3
    Case 2
        TL2 = TL2 + 3
    Case 3
        TL3 = TL3 + 3
    Case 4
        TL4 = TL4 + 3
    Case 5
        TL5 = TL5 + 3
    Case 6
        TL6 = TL6 + 3
    Case 7
        TL7 = TL7 + 3
    Case 8
        TL8 = TL8 + 3
    Case 9
        TL9 = TL9 + 3
    End Select
   
    Debug.Print "TL0 = " & TL0
    Debug.Print "TL1 = " & TL1
    Debug.Print "TL2 = " & TL2
    Debug.Print "TL3 = " & TL3
    Debug.Print "TL4 = " & TL4
    Debug.Print "TL5 = " & TL5
    Debug.Print "TL6 = " & TL6
    Debug.Print "TL7 = " & TL7
    Debug.Print "TL8 = " & TL8
    Debug.Print "TL9 = " & TL9
End Function

 

Thanks for your help!!

 

Doyce



---In MS_Access_Professionals@yahoogroups.com, <JohnV@...> wrote :

Doyce-

 

Sure wish our old pal, A.D. Tejpal, was still around - I'm sure he would have an elegant solution.

 

Do you want all ten counts returned in one function call, or do you want to call the function 10 times?

 

Simple call for each digit:

 

intNine = CountDigit(Me.UnitNumber, 9)

 

Function CountDigit(lngUnit As Long, intDigit As Integer) As Integer

Dim strUnit As String, intCount As Integer, intI As Integer

 

    ' Convert the input number to a string

    strUnit = Format(lngUnit, "00000")

    For intI = 1 To 5

        If Mid(strUnit, intI, 1) = intDigit Then intCount = intCount + 1

    Next intI

 

     ' Return the answer

     CountDigit = intCount

End Function 

John Viescas, author

Effective SQL

SQL Queries for Mere Mortals

Microsoft Office Access 2010 Inside Out

Microsoft Office Access 2007 Inside Out

Building Access Applications

 

On Aug 22, 2016, at 06:18, winberry.doyce@... [MS_Access_Professionals] <MS_Access_Professionals@yahoogroups.com> wrote:

Hello Pros,

At my work, we are engaged in a project where we are replacing the unit numbers on groups of trailers. I need a function that will take the unit number and tell me how many of each digit there are, for example unit number 44095 has 1 zero, 2, fours, 1, five and 1 nine. All the unit numbers have five digits. I'm not sure how to approach this. I know how to extract each digit from the unit number and I assume I should use a select case statement to return the value. But I'm not sure how to put it together and get the totals back from the function. I appreciate all help I receive.

Doyce







This email (and all attachments) is for the sole use of the intended recipient(s) and may contain privileged and/or proprietary information. Any unauthorized review, use, disclosure or distribution is prohibited. If you are not the intended recipient, please contact the sender by reply e-mail and destroy all copies of the original message.

__._,_.___

Posted by: crystal 8 <strive4peace2008@yahoo.com>
Reply via web post Reply to sender Reply to group Start a New Topic Messages in this topic (7)

Have you tried the highest rated email app?
With 4.5 stars in iTunes, the Yahoo Mail app is the highest rated email app on the market. What are you waiting for? Now you can access all your inboxes (Gmail, Outlook, AOL and more) in one place. Never delete an email again with 1000GB of free cloud storage.


.

__,_._,___

Tidak ada komentar:

Posting Komentar