I have a vb net program to take a binary value in the image. This syntax produces
111110
on textbox3.text. I want no spaces at textbox3.text
1 1 1 1 1 0
Dim x, y As Integer
Dim gambar As New Bitmap(PictureBox7.Image)
Dim gray, vektor, biner As Integer
'biner
'With gambar
For x = 0 To gambar.Width - 1
For y = 0 To gambar.Height - 1
gray = (CInt(gambar.GetPixel(x, y).R) + _
gambar.GetPixel(x, y).G + _
gambar.GetPixel(x, y).B) / 3
gambar.SetPixel(x, y, Color.FromArgb(gray, gray, gray))
If gray > 128 Then
biner = 255
Else
biner = 0
End If
gambar.SetPixel(x, y, Color.FromArgb(biner, biner, biner))
'ttup proses grayscale
If (biner = 0) Then
vektor = 0
End If
If (biner = 255) Then
vektor = 1
End If
'TextBox2.Text = pixel_putihblkg2
TextBox3.SelectedText = vektor.ToString
Next y
PictureBox7.Refresh()
PictureBox7.Image = gambar
Next x
PictureBox7.SizeMode = PictureBoxSizeMode.StretchImage
Catch exc As Exception
End Try
Your request is unclear, but if I interpret your example correctly, you want to insert a space between each digit in your string before assigning it to the TextBox. You can do this with a modified loop and String.Insert.
Dim spacedString As String = vektor.ToString
For i As Integer = 0 To (spacedString.Length * 2) Step 2
spacedString = spacedString.Insert(i + 1, " ")
Next
TextBox3.Text = spacedString
Here I'm copying vektor.ToString into a new variable, which will then be modified. The For loop increments from zero to twice the length of the unmodified string (because the final string will be twice as long), and steps by two (to insert after each character plus space, or two positions). For each iteration, use .Insert to insert a space. Finally, assign the modified string to the TextBox.
This will result in an extra space at the end of the string. If this is a problem, you can use String.TrimEnd to remove it.
TextBox3.Text = spacedString.TrimEnd(" "c)
Update: I failed to notice that you seem to be inserting one digit at a time to the TextBox. In this case you can simply add the spaces directly in code.
TextBox3.Text &= vektor.ToString & " "
Related
I want to remove characters from a string based on the position. i use the below code and i manage to:
Insert all word letters in an array
Loop the array and replace the letters that i want with nothing
BUT i dont know have to remove nothing from the array, recreate array index and create the word again without those characters.
'Create an array with all letters
For j = 1 To Len(SheetName2)
ReDim Preserve arrWord(k)
arrWord(k) = Mid(SheetName2, j, 1)
k = k + 1
Next j
Counter = (Len(SheetName2) - 31) * 2
'Loop array and replace with nothing
For w = Counter - 1 To 0 Step -2
arrWord(w) = ""
Next w
You don't need an array of the characters. Just read every second character into a new string.
Public Sub OutputEverySecondChar()
Dim TestString As String
TestString = "abcdefghij"
Dim OutputString As String
Dim iChar As Long
For iChar = 1 To Len(TestString) Step 2
OutputString = OutputString & Mid$(TestString, iChar, 1)
Next iChar
Debug.Print OutputString 'output is: acegi
End Sub
Or even better as re-useable function:
Public Sub test()
Debug.Print ReturnEveryXcharcter(InputString:="abcdefghij", FirstChar:=1, xChar:=2, CharLength:=1)
End Sub
Public Function ReturnEveryXcharcter(InputString As String, FirstChar As Long, xChar As Long, CharLength As Long) As String
Dim iChar As Long
For iChar = FirstChar To Len(InputString) Step xChar
ReturnEveryXcharcter = ReturnEveryXcharcter & Mid$(InputString, iChar, CharLength)
Next iChar
End Function
So the function is even more flexible and you can eg use the following to delete every 3ʳᵈ character (beginning with the first):
Debug.Print ReturnEveryXcharcter(InputString:="abcdefghij", FirstChar:=2, xChar:=3, CharLength:=2)
'output will be: bcefhi
Edit according comment:
Then loop until it is less then 31 characters:
Public Sub test()
Dim SheetName As String
SheetName = "1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890"
Do
SheetName = ReturnEveryXcharcter(InputString:=SheetName, FirstChar:=1, xChar:=2, CharLength:=1, LengthLimit:=31)
Loop While Len(SheetName) > 31
Debug.Print SheetName
End Sub
My solution:
If Len(SheetName1) > 31 Then
SheetName2 = Replace(SheetName1, " ", "")
'Third check - Remove letter by letter starting from the beginning
If Len(SheetName2) > 31 Then
Counter = (Len(SheetName2) - 31) * 2
Part_1 = Left(SheetName2, Counter)
Part_2 = Mid(SheetName2, Counter + 1, Len(SheetName2) - (Counter))
Semi_Part = ""
For j = 1 To Counter Step 2
'Use only Part_1 because it ll be the same in all occurance
Semi_Part = Semi_Part + Mid(Part_1, j, 1)
Next j
FinalSheetname = Semi_Part & Part_2
Else
FinalSheetname = SheetName2
End If
Else
FinalSheetname = SheetName1
End If
Just for interest, you can also do this with a worksheet function if you have one of the more recent versions of Excel (O365 or 2016+) that has the CONCAT function.
The "trick" is to create an array that includes the positions of the characters you wish to retain.
In the case of deleting every even space positioned character (retaining the odd positions):
=CONCAT(MID(A1,(ROW(INDEX($A:$A,1,1):INDEX($A:$A,ROUNDUP(LEN(A1)/2,0),1))-1)*2+1,1))
Since this is an array formula, you need to "confirm" it by holding down ctrl + shift while hitting enter. If you do this correctly, Excel will place braces {...} around the formula as observed in the formula bar
I have a series of 2 cells in which values are separated by a comma delimiter.
Example
Cell D1 = 1,2,3,4,5,6,7,8,9,10
Cell O1 = 1,2,3,4,5,6
I want to first use the split function to pass the values to an Array and subsequently compare those 2 Arrays to find out the unique/not double values.
These values then i want to write to another cell as values with a comma delimiter.
Based on this answer
Comparing two Dimension array
and something I found about adding values to an Array i tried my luck with this code
Sub compare()
Dim cont As Long
Dim x As Long
Dim y As Long
Dim Source As Variant
Dim Comparison As Variant
Dim Target As Variant
With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(Rows.Count, 4).End(xlUp).Row
Source = Split(.Range("D" & cont).Value, ",")
Comparison = Split(.Range("O" & cont).Value, ",")
For x = LBound(Source) To UBound(Source)
For y = LBound(Comparison) To UBound(Comparison)
If Source(x, y) = !Comparison(x, y) Then
Target(UBound(Target)) = Source(x, y).Value
Next
Next
Next cont
End Sub
But seem to be stuck.
Is this the correct way to add a value to the Array Target?
How do I get the Array into the cell?
The result in my example should be for Target to contain "7", "8", "9" , and "10" and should be shown in a cell in the way
7,8,9,10
Thank you for your help!
Some issues:
Rows.Count will look in the active sheet, not necessarily in the "Open items" sheet. So you need to add the dot: .Rows.Count
Source(x, y) will not work, since Source only has one dimension. In fact y has nothing to do with Source. A similar remark holds for Comparison.
= ! is not a valid comparison operator. You maybe intended <>.
Target is not defined, and Target(UBound(Target)) will always refer to the same location. Instead, you could append the result to a string variable immediately.
Furthermore, I would use a Collection object for fast look up, so that the algorithm is not O(n²), but O(n):
Sub Compare()
Dim cont As Long
Dim source As Variant
Dim comparison As Variant
Dim part As Variant
Dim parts As Collection
Dim result As String
With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
source = Split(.Range("D" & cont).Value, ",")
comparison = Split(.Range("O" & cont).Value, ",")
' Add the source items in a collection for faster look-up
Set parts = New Collection
For Each part In source
parts.Add Trim(part), Trim(part)
Next
' Remove the comparison items from the collection
For Each part In comparison
On Error Resume Next ' Ignore error when part is not in parts
parts.Remove Trim(part)
If Err Then parts.Add Trim(part), Trim(part) ' Add part if not yet in parts
On Error GoTo 0 ' Stop ignoring errors
Next
' Turn the remaining collection to comma-separated string
result = ""
For Each part In parts
result = result & ", " & part
Next
result = Mid(result, 3) ' Remove first comma and space
' Store the result somewhere, for example in the E column
.Range("E" & cont).Value = result
Next cont
End With
End Sub
Alternative for Sorted Lists
When your source and comparison lists are sorted in numerical order, and you need the target to maintain that sort order, you could use a tandem-kind of iteration, like this:
Sub Compare()
Dim cont As Long
Dim source As Variant
Dim comparison As Variant
Dim x As Long
Dim y As Long
Dim result As String
With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
source = Split(.Range("D" & cont).Value, ",")
comparison = Split(.Range("O" & cont).Value, ",")
x = LBound(source)
y = LBound(comparison)
result = ""
Do While x <= UBound(source) And y <= UBound(comparison)
If Val(source(x)) < Val(comparison(y)) Then
result = result & ", " & Trim(source(x))
x = x + 1
ElseIf Val(source(x)) > Val(comparison(y)) Then
result = result & ", " & Trim(comparison(y))
y = y + 1
Else
x = x + 1
y = y + 1
End If
Loop
' Flush the remainder of either source or comparison
Do While x <= UBound(source)
result = result & ", " & Trim(source(x))
x = x + 1
Loop
Do While y <= UBound(comparison)
result = result & ", " & Trim(comparison(y))
y = y + 1
Loop
result = Mid(result, 3) ' Remove first comma and space
' Store the result somewhere, for example in the E column
.Range("E" & cont).Value = result
Next cont
End With
End Sub
Try this small UDF():
Public Function unikue(BigString As String, LittleString As String) As String
Dim B As Variant, L As Variant, Barr, Larr
Dim Good As Boolean
Barr = Split(BigString, ",")
Larr = Split(LittleString, ",")
For Each B In Barr
Good = True
For Each L In Larr
If L = B Then Good = False
Next
If Good Then unikue = unikue & "," & B
Next B
If unikue <> "" Then unikue = Mid(unikue, 2)
End Function
Couple of things with this code
the variable Target() - You never tell code how big this array is or if you want to make it bigger - my full code below will grow for each match that is found
Source(x, y).Value - You dont need to use Value for arrays. you also do not need x and y as you are only reading in one column you only need source(x)
Where I have wrote MISSING in the full code - these lines where missing and would have caused you issues.
The purpose of Found is that for every time source(x) is found in Comparison(y) then Found is incremented. If it has never been incremented then we can assume that it is to be captured in target.
One other note is that you do not specify where you want to output Target to. so currently the target array does not go anywhere
Sub compare()
Dim cont As Long
Dim x As Long
Dim y As Long
Dim Source As Variant
Dim Comparison As Variant
Dim Target() As Variant
ReDim Target(1)
With ThisWorkbook.Worksheets("Open items")
For cont = 1 To .Cells(.Rows.Count, 4).End(xlUp).Row
Source = Split(.Range("D" & cont).Value, ",")
Comparison = Split(.Range("O" & cont).Value, ",")
For x = LBound(Source) To UBound(Source)
Found = 0
For y = LBound(Comparison) To UBound(Comparison)
If Source(x) = Comparison(y) Then
Found = Found + 1
'count if found
End If 'MISSING
Next
'if values are found dont add to target
If Found = 0 Then
Target(UBound(Target)) = Source(x)
ReDim Preserve Target(UBound(Target) + 1)
End If
Next
Next cont
End With 'MISSING
End Sub
I am trying to use VBA in Excel to write all of the possible combinations of the contents of three arrays to a column to create a wordlist.
Currently, I know how to loop through the arrays and get some output that I want but I can't figure out how to build the loop to give me all possible combinations of the baseWord(n) & numberCharSet(n) & specialCharSet(n).
How do I properly loop through the baseWord array to get all combinations of each baseWord with the contents of the specialCharSet and numberCharSet arrays?
Example:
Cloud1!
Cloud1#
Cloud1#
Cloud1$
Cloud2!
etc...
Private Sub createWordlist()
Dim baseWord(1 To 2) As String
baseWord(1) = "Cloud"
baseWord(2) = "cloud"
Dim numberCharSet(1 To 4) As String
numberCharSet(1) = "1"
numberCharSet(2) = "2"
numberCharSet(3) = "3"
numberCharSet(4) = "4"
Dim specialCharSet(1 To 4) As String
specialCharSet(1) = "!"
specialCharSet(2) = "#"
specialCharSet(3) = "#"
specialCharSet(4) = "$"
x = 1
y = 1
z = 4
w = 1
For Each Item In baseWord
Range("A" & x).Value = baseWord(w) & numberCharSet(y) & specialCharSet(z)
x = x + 1
y = y + 1
z = z - 1
Next
End Sub
As #ScottCraner mentioned in the comments, all you need to do is nest 3 loops:
For Each word In baseWord
For Each num In numberCharSet
For Each special In specialCharSet
Debug.Print word & num & special
Next
Next
Next
I'm currently working on a program that will convert a string into "combined integer" (namely: from a string, it will be splitted into two characters at a time and then each character in each group will be converted into ASCII number. Then, the first character is multiplied by 256 (shift 8 bit to the left) and add second character. It must not eliminate/forget any character inside the string
Here is when the trouble really begin: it threw IndexOutOfRangeException
Dim input As String = TextBox1.Text.PadLeft(1)
Dim charArr As Char() = input.ToCharArray
Dim intGroup As UShort
Dim strout As String = ""
For index = 0 To charArr.Length - 2 Step 2
Dim i = index
Dim a = charArr(i)
Dim b = charArr(i + 1)
intGroup = CByte(AscW(a)) * 256 + CByte(AscW(b))
strout = strout + CStr(intGroup) + " "
Next
MsgBox(strout)
My guess was that I modify the index inside the loop which is 'forbidden'.
Any possible solution??
Thanks
I would do something like this but I don't know how you want to deal with odd length strings:
For index = 0 To charArr.Length - 1 Step 2
Dim a = charArr(index)
Dim b = If(index=charArr.Length - 1, _
<something to use for odd length strings>, _
charArr(index + 1))
intGroup = CByte(AscW(a)) * 256 + CByte(AscW(b))
strout = strout + CStr(intGroup) + " "
Next
I don't know what you want to use, especially if you bear in mind that .NET strings (unlike, say, C strings) can perfectly well contain a character with ascii code 0, so just using 0 may leave you with ambiguous data, depending on how you're using this string that you're constructing.
But basically, it comes down to you needing to do some special handling for odd length strings, and no magic manipulation of the for loop parameters will avoid that fact - you either deal with them in the loop (as above) or use a shorter loop (.Length - 2) and perform a length check afterwards and deal with the final character that you missed in the loop separately.
For index = 0 To input.Length - 2 step 2
array its zero based, so if the lenght = n, last element is arr[n-1].
for handle only odds element, the last element its arr[n-2].
I'm writing a code that checks if a word has multiple of the same letters in it, so I split each letter into an array and wrote this code. the "correctGuesses" variable is supposed to be the number of duplicate letters. The Array contains the strings ("H, E, L, L ,O").
Dim newCharArray() As Char = wordArray(rndNumber).ToCharArray
ReDim Preserve charToString_2(newCharArray.Length - 1)
Dim cBoolean As Boolean = False
For i As Integer = 0 To (newCharArray.Length - 1) Step 1
charToString_2(i) = newCharArray(i)
MsgBox(charToString_2(i))
Next
For j As Integer = 0 To (charToString_2.Length - 1) Step 1
For b As Integer = 0 To (charToString_2.Length - 1) Step 1
MsgBox("Is " & charToString_2(j) & " = " & charToString_2(b) & "?")
If j = b Then
MsgBox(j & " is equal to " & b & ", continuing.")
Exit For
End If
If CStr(charToString_2(b)) = CStr(charToString_2(b)) Then
MsgBox("Yes, +1")
correctGuesses += 1
charToString_2(b) = "Replaced"
cBoolean = True
End If
MsgBox("No, Continuing.")
Next
Next
The first if statement works, so whenever j = b, it exits and proceeds. But then the next loop, it checks if "E" is equal to "H", and it returns true! I have no idea why!
Your algorithm is almost there. You can tweak it a little.
Dim stringtoCheck As String = wordArray(rndNumber)
For j As Integer = 0 To (stringtoCheck.Length - 2)
For b As Integer = j+1 To (stringtoCheck.Length - 1)
If stringtoCheck.chars(b) = stringtoCheck.chars(j) Then
correctGuesses += 1
cBoolean = True
End If
Next
Next
This provides counts for the different characters in a string. Casing is shown.
Dim wordToCheck As String = "heLlo racecar" 'note L and l
Dim lettercounts As New Dictionary(Of Char, Integer)
For Each c As Char In wordToCheck ' .ToUpperInvariant '.ToLowerInvariant
If Not lettercounts.ContainsKey(c) Then
Dim ct As Integer = wordToCheck.Count(Function(ch) ch = c)
lettercounts.Add(c, ct)
End If
Next
'show the counts
For Each ltrct As KeyValuePair(Of Char, Integer) In lettercounts
Debug.WriteLine(String.Format("{0} {1}", ltrct.Key, ltrct.Value))
Next