Click here to Skip to main content
15,911,531 members
Home / Discussions / Visual Basic
   

Visual Basic

 
GeneralRe: Help on Astrolgical Calculation Pin
john john mackey20-Sep-05 7:25
john john mackey20-Sep-05 7:25 
Questionhow can we View the Finded data in Datagrid Pin
mani_tac18-Sep-05 19:52
mani_tac18-Sep-05 19:52 
QuestionCurrency format Pin
dennysoe18-Sep-05 18:37
dennysoe18-Sep-05 18:37 
GeneralRe: Currency format Pin
Gopi.V18-Sep-05 22:21
Gopi.V18-Sep-05 22:21 
GeneralRe: Currency format Pin
dennysoe19-Sep-05 16:39
dennysoe19-Sep-05 16:39 
Questioncreate strings by one giving string Pin
LyBun18-Sep-05 18:28
LyBun18-Sep-05 18:28 
AnswerRe: create strings by one giving string Pin
Steve Pullan18-Sep-05 18:46
Steve Pullan18-Sep-05 18:46 
AnswerRe: create strings by one giving string Pin
Steve Pullan19-Sep-05 17:54
Steve Pullan19-Sep-05 17:54 
I have rewritten your code to use a recursive Sub rather than a Function. The main problem with your examle is that you were not inspecting all possible combinations of the input string (i.e. only one iteration of the For...Next loop was ever executed). It can be refined further but this will do for a brief explanation.

This example also uses a Scripting.Dictionary object rather than an array because it simplifies the detection of duplicate strings (I assumed that duplicates were not permitted). Look this up in the VB help files for more information.
Option Explicit

Private Sub GenerateStrings()

    Dim wd As Scripting.Dictionary
    Set wd = New Scripting.Dictionary
    
    Call test2("some", wd)
    
    'Command1.Caption = wd.Count
    
End Sub

Sub test2(str As String, ByRef wd As Scripting.Dictionary)
    
    Dim ch As String
    Dim ch1 As String
    Dim ch2 As String
    Dim wlen As Integer
    Dim i As Integer
    
    wlen = Len(str)
    
    For i = 1 To wlen
    
        ch1 = Left(str, i - 1)
        ch = Mid(str, i, 1)
        ch2 = Mid(str, i + 1, wlen)
        
        Select Case ch
            
            Case "s"
                Call test2(ch1 & "a" & ch2, wd)
                Call test2(ch1 & "c" & ch2, wd)
            
            Case "m"
                Call test2(ch1 & "k" & ch2, wd)
                Call test2(ch1 & "l" & ch2, wd)
                Call test2(ch1 & "u" & ch2, wd)
            
            Case "e"
                Call test2(ch1 & "b" & ch2, wd)
                Call test2(ch1 & "h" & ch2, wd)
            
            Case Else
            
        End Select
    
    Next
    
    If Not wd.exists(str) Then
    
        Debug.Print str
        
        wd.Add str, str
    End If
    
End Sub

'Function test1(str As String) As String()
'    Dim wd() As String, ch As String, ch1 As String, ch2 As String
'    Dim wlen As Integer, i As Integer, j As Integer
'    j = 0
'    wlen = Len(str)
'    For i = 1 To wlen
'          ch1 = Left(str, i - 1)
'          ch = Mid(str, i, 1)
'          ch2 = Mid(str, i + 1, wlen)
'
'          If ch = "s" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "a" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "c" & ch2
'                 j = j + 1
'          End If
'          If ch = "a" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "s" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "c" & ch2
'                 j = j + 1
'          End If
'           If ch = "c" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "s" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "a" & ch2
'                 j = j + 1
'          End If
'
'           If ch = "m" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "k" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "l" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "u" & ch2
'                 j = j + 1
'          End If
'          If ch = "k" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "m" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "l" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "u" & ch2
'                 j = j + 1
'          End If
'          If ch = "l" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "k" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "m" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "u" & ch2
'                 j = j + 1
'          End If
'          If ch = "u" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "k" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "l" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "m" & ch2
'                 j = j + 1
'          End If
'           If ch = "e" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "b" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "h" & ch2
'                 j = j + 1
'          End If
'          If ch = "b" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "e" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "h" & ch2
'                 j = j + 1
'          End If
'           If ch = "h" Then
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "e" & ch2
'                 j = j + 1
'                 ReDim Preserve wd(j)
'                 wd(j) = ch1 & "b" & ch2
'                 j = j + 1
'          End If
'
'    Next
'    test1 = wd
'End Function
'


...Steve
AnswerRe: create strings by one giving string Pin
Steve Pullan20-Sep-05 13:07
Steve Pullan20-Sep-05 13:07 
QuestionInsert values into SQL database from webform Pin
BORN...again!18-Sep-05 15:34
BORN...again!18-Sep-05 15:34 
AnswerRe: Insert values into SQL database from webform Pin
tatchung18-Sep-05 16:09
tatchung18-Sep-05 16:09 
GeneralRe: Insert values into SQL database from webform Pin
BORN...again!18-Sep-05 16:26
BORN...again!18-Sep-05 16:26 
GeneralRe: Insert values into SQL database from webform Pin
tatchung18-Sep-05 16:47
tatchung18-Sep-05 16:47 
AnswerRe: Insert values into SQL database from webform Pin
Edbert P18-Sep-05 20:55
Edbert P18-Sep-05 20:55 
QuestionDatabinding to datagrid Pin
SLG3118-Sep-05 9:23
SLG3118-Sep-05 9:23 
AnswerRe: Databinding to datagrid Pin
KaptinKrunch18-Sep-05 17:37
KaptinKrunch18-Sep-05 17:37 
GeneralRe: Databinding to datagrid Pin
SLG3118-Sep-05 22:00
SLG3118-Sep-05 22:00 
QuestionJoystick/Gamepad Pin
Jerry___18-Sep-05 8:28
Jerry___18-Sep-05 8:28 
AnswerRe: Joystick/Gamepad Pin
Christian Graus18-Sep-05 11:05
protectorChristian Graus18-Sep-05 11:05 
GeneralRe: Joystick/Gamepad Pin
Jerry___18-Sep-05 12:05
Jerry___18-Sep-05 12:05 
GeneralRe: Joystick/Gamepad Pin
Christian Graus18-Sep-05 12:12
protectorChristian Graus18-Sep-05 12:12 
GeneralRe: Joystick/Gamepad Pin
Jerry___19-Sep-05 0:32
Jerry___19-Sep-05 0:32 
GeneralRe: Joystick/Gamepad Pin
Dave Kreskowiak19-Sep-05 1:04
mveDave Kreskowiak19-Sep-05 1:04 
GeneralRe: Joystick/Gamepad Pin
Jerry___19-Sep-05 3:06
Jerry___19-Sep-05 3:06 
GeneralRe: Joystick/Gamepad Pin
Dave Kreskowiak19-Sep-05 5:15
mveDave Kreskowiak19-Sep-05 5:15 

General General    News News    Suggestion Suggestion    Question Question    Bug Bug    Answer Answer    Joke Joke    Praise Praise    Rant Rant    Admin Admin   

Use Ctrl+Left/Right to switch messages, Ctrl+Up/Down to switch threads, Ctrl+Shift+Left/Right to switch pages.