Good morning. I hate to bother you guys but I encountered with problem which really stumped me.
I have the Excel file where I have 2 columns where I must divided 1 column by another and insert this result into SQL table.
Here is the snapshot of excel file, where I underline the problem row.
If values in both columns have "," like in other rows then everything is fine, but if 1 have "," and another doesn't then I get wrong result.
For example the compiler read the 147 like 147.0 {Double} and 60,75 like "60,75"{String}. If everything is fine I should get the result 2,41, but I got 0,024 (it is like 60,75 is converted to 6075). Unfortunately I can't modify Excel file. How can I get the right result?
Here is the code for division:
Dim usedRange = xlsWorkSheet.Range("E7", "F57")
Dim usedRangeAs2DArray As Object(,) = usedRange.Value2
Dim TeamIndex(), import As String
ReDim TeamIndex(usedRange.Rows.Count)
For i As Integer = 1 To usedRange.Rows.Count
If (usedRangeAs2DArray(i, 1) = 0 And usedRangeAs2DArray(i, 2) = 0)
Or usedRangeAs2DArray(i, 2) = 0 Then
z = 1
TeamIndex(i) = z
Else
g = Convert.ToString(usedRangeAs2DArray(i, 1))
z = g / Convert.ToDouble(usedRangeAs2DArray(i, 2))
z = Math.Floor(100 * z) / 100
TeamIndex(i) = z
End If
Next
I tried to use Convert.ToString(), use Replace "." with "," and String.Format("{0:N2}", g) on first column, but this approaches simply ignored.
Thank you in advance.
I guess I found not very beautiful, but nonetheless working solution to this problem.
The main idea if I have integer value, without "," which is readed by compiler as type {Double}, I simple append ",00" string to this value.
Here is my modified code.
Dim usedRange = xlsWorkSheet.Range("E7", "F57")
Dim usedRangeAs2DArray As Object(,) = usedRange.Value2
Dim TeamIndex(), import As String
ReDim TeamIndex(usedRange.Rows.Count)
For i As Integer = 1 To usedRange.Rows.Count
If (usedRangeAs2DArray(i, 1) = 0 And usedRangeAs2DArray(i, 2) = 0)
Or usedRangeAs2DArray(i, 2) = 0 Then
z = 1
TeamIndex(i) = z
Else
If TypeOf usedRangeAs2DArray(i, 1) Is System.Double Then
usedRangeAs2DArray(i, 1) = String.Concat(usedRangeAs2DArray(i, 1), ",00")
End If
If TypeOf usedRangeAs2DArray(i, 2) Is System.Double Then
usedRangeAs2DArray(i, 2) = String.Concat(usedRangeAs2DArray(i, 2), ",00")
End If
z = usedRangeAs2DArray(i, 1) / usedRangeAs2DArray(i, 2)
z = Math.Floor(100 * z) / 100
TeamIndex(i) = z
End If
Next
UPDATE:
Found better solution, convert both values to Double and replace "," with ".".
Here is code for this:
Dim fDD, sDD As Double
If IsNumeric(usedRangeAs2DArray(i, 2)) And IsNumeric(usedRangeAs2DArray(i, 1)) Then
fDD = CDbl(usedRangeAs2DArray(i, 1).ToString().Replace(",", "."))
sDD = CDbl(usedRangeAs2DArray(i, 2).ToString().Replace(",", "."))
End If
z = fDD / sDD
z = Math.Floor(100 * z) / 100
TeamIndex(i) = z
Related
So, I made a fun and simple macro that randomly selects R, G, and B values until it uses every possible combination (skipping repeats), and setting the color values of a 10x10 square with each new color.
The only problem is that I have run into the limit for the number of cell formats. Microsoft says that the limit should be around 64000, but I found it to be exactly 65429 on a blank workbook in Excel 2013.
I've included a clear format code, but it seems to have no effect:
Cells(X, Y).ClearFormats
Microsoft lists some resolutions, but 3 out of the 4 of them are essentially "Don't make too many formats", and the 4th format is to use a third party application.
Is there really nothing that can be done in VBA?
A1:J10 will print a new color
K1 will print the percentage to completion
L1 will print the number of colors used
M1 will print the number of times a color combination is repeated
Dim CA(255, 255, 255) As Integer
Dim CC As Long
Dim RC As Long
Dim R As Integer
Dim G As Integer
Dim B As Integer
Dim X As Integer
Dim Y As Integer
CC = 0
RC = 0
X = 1
Y = 1
Do While ColorCount < 16777216
R = ((Rnd * 256) - 0.5)
G = ((Rnd * 256) - 0.5)
B = ((Rnd * 256) - 0.5)
If CA(R, G, B) <> 1 Then
CA(R, G, B) = 1
'Step down to the next row
'If at the 10th row, jump back to the first and move to the next column
If X < 10 Then
X = X + 1
Else
X = 1
If Y < 10 Then
Y = Y + 1
Else
Y = 1
End If
End If
Cells(X, Y).ClearFormats 'doesn't do what I hope :(
Cells(X, Y).Interior.Color = RGB(R, G, B)
CC = CC + 1
Cells(1, 11).Value = (CC / 16777216) * 100
Cells(1, 12).Value = CC
Else
RC = RC + 1
Cells(1, 13).Value = RC
End If
Loop
There are several ways to resolve this issue, but the cleanest and easiest method is to remove all extra styles (I have seen workbooks with 9000+ styles )
With the following simple VBA code you can remove all non-builtin styles and in the vast majority of cases this fixes the error.
Sub removeStyles()
Dim li as long
On Error Resume Next
With ActiveWorkbook
For li = .Styles.Count To 1 Step -1
If Not .Styles(li).BuiltIn Then
.Styles(li).Delete
End If
Next
End With
End Sub
Here is my problem:
I am parsing a xml using excel VBA. I open the XML file as regular excel file, Then I go to column which is of my interest.
Cells in that column are 16 character.
So I am parsing each of those characters using Left and Right functions and saving them in a new file.
Mostly those 16 characters are Numeric and sometimes Alpha Character.
example 1111000011110000 or 1111YYYY00001111
when it parses 1111YYYY00001111 -- I get correct output,
like in new file Cell(1,1) =1 Cell(1,1) =1 Cell(1,2) =1 Cell(1,3) =1 Cell(1,4) =1 Cell(1,5) =Y and so on
But When I parse 1111000011110000 -- I dont get the correct output
I get Cell(1,1) =1 Cell(1,2) =. Cell(1,3) =1 Cell(1,4) =1 Cell(1,5) =1 Cell(1,6) =0
I tried to put NumberFormat="0" for column which I was parsing, but still i get the same output.
I also tried to put the debug variables and stored them as strings, Double Integer but I could not get pass it.
Here is my code:
Workbooks.Add
strip_concat = ActiveWorkbook.Name
Workbooks(strip_concat).Sheets(1).Cells(1, 1) = "Subid"
Workbooks(strip_concat).Sheets(1).Cells(1, 2) = "Strip#"
Workbooks(strip_concat).Sheets(1).Cells(1, 3) = "X"
Workbooks(strip_concat).Sheets(1).Cells(1, 4) = "Y"
Workbooks(strip_concat).Sheets(1).Cells(1, 5) = "Reject Code"
Workbooks(strip_concat).Sheets(1).Cells(1, 6) = "X-Y"
Workbooks.OpenXML Filename:=xml_file
stripfile = ActiveWorkbook.Name
For C = 3 To strip_col - 1
r = 1
Do
Y = r
x = C - 2
Workbooks(strip_concat).Sheets(1).Cells(A, 3) = x
Workbooks(strip_concat).Sheets(1).Cells(A, 4) = Y
Workbooks(strip_concat).Sheets(1).Cells(A, 6).NumberFormat = "#"
Workbooks(strip_concat).Sheets(1).Cells(A, 6) = x & "-" & Y
Workbooks(strip_concat).Sheets(1).Cells(A, 1) = Workbooks(stripfile).Sheets(1).Cells(C, Amkor_id_col)
Workbooks(strip_concat).Sheets(1).Cells(A, 2) = ExtractElement(Workbooks(stripfile).Sheets(1).Cells(C, Strip_num_col), 2, ".")
Workbooks(strip_concat).Sheets(1).Cells(A, 5) = Right(Left(Workbooks(stripfile).Sheets(1).Cells(C, Defect_data_col + i), r), 1)
r = r + 1
A = A + 1
Loop Until (r > 16)
If ((x Mod 13) = 0) Then i = i + 1
Next C
from xml file 1131111111111111
I got it working.. This is what I did
Dim x as variant
x = (Workbooks(stripfile).Sheets(1).Cells(C, Defect_data_col + i).Text
Workbooks(strip_concat).Sheets(1).Cells(A, 5) = Right(Left(x,r),1
I am banging my head against the wall for a while now trying different techniques.
None of them are working well.
I have two strings.
I need to compare them and get an exact percentage of match,
ie. "four score and seven years ago" TO "for scor and sevn yeres ago"
Well, I first started by comparing every word to every word, tracking every hit, and percentage = count \ numOfWords. Nope, didn't take into account misspelled words.
("four" <> "for" even though it is close)
Then I started by trying to compare every char in each char, incrementing the string char if not a match (to count for misspellings). But, I would get false hits because the first string could have every char in the second but not in the exact order of the second. ("stuff avail" <> "stu vail" (but it would come back as such, low percentage, but a hit. 9 \ 11 = 81%))
SO, I then tried comparing PAIRS of chars in each string. If string1[i] = string2[k] AND string1[i+1] = string2[k+1], increment the count, and increment the "k" when it doesn't match (to track mispellings. "for" and "four" should come back with a 75% hit.) That doesn't seem to work either. It is getting closer, but even with an exact match it is only returns 94%. And then it really gets screwed up when something is really misspelled. (Code at the bottom)
Any ideas or directions to go?
Code
count = 0
j = 0
k = 0
While j < strTempName.Length - 2 And k < strTempFile.Length - 2
' To ignore non letters or digits '
If Not strTempName(j).IsLetter(strTempName(j)) Then
j += 1
End If
' To ignore non letters or digits '
If Not strTempFile(k).IsLetter(strTempFile(k)) Then
k += 1
End If
' compare pair of chars '
While (strTempName(j) <> strTempFile(k) And _
strTempName(j + 1) <> strTempFile(k + 1) And _
k < strTempFile.Length - 2)
k += 1
End While
count += 1
j += 1
k += 1
End While
perc = count / (strTempName.Length - 1)
Edit: I have been doing some research and I think I initially found the code from here and translated it to vbnet years ago. It uses the Levenshtein string matching algorithm.
Here is the code I use for that, hope it helps:
Sub Main()
Dim string1 As String = "four score and seven years ago"
Dim string2 As String = "for scor and sevn yeres ago"
Dim similarity As Single =
GetSimilarity(string1, string2)
' RESULT : 0.8
End Sub
Public Function GetSimilarity(string1 As String, string2 As String) As Single
Dim dis As Single = ComputeDistance(string1, string2)
Dim maxLen As Single = string1.Length
If maxLen < string2.Length Then
maxLen = string2.Length
End If
If maxLen = 0.0F Then
Return 1.0F
Else
Return 1.0F - dis / maxLen
End If
End Function
Private Function ComputeDistance(s As String, t As String) As Integer
Dim n As Integer = s.Length
Dim m As Integer = t.Length
Dim distance As Integer(,) = New Integer(n, m) {}
' matrix
Dim cost As Integer = 0
If n = 0 Then
Return m
End If
If m = 0 Then
Return n
End If
'init1
Dim i As Integer = 0
While i <= n
distance(i, 0) = System.Math.Max(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Max(System.Threading.Interlocked.Increment(j), j - 1)
End While
'find min distance
For i = 1 To n
For j = 1 To m
cost = (If(t.Substring(j - 1, 1) = s.Substring(i - 1, 1), 0, 1))
distance(i, j) = Math.Min(distance(i - 1, j) + 1, Math.Min(distance(i, j - 1) + 1, distance(i - 1, j - 1) + cost))
Next
Next
Return distance(n, m)
End Function
Did not work for me unless one (or both) of following are done:
1) use option compare statement "Option Compare Text" before any Import declarations and before Class definition (i.e. the very, very first line)
2) convert both strings to lowercase using .tolower
Xavier's code must be correct to:
While i <= n
distance(i, 0) = System.Math.Min(System.Threading.Interlocked.Increment(i), i - 1)
End While
Dim j As Integer = 0
While j <= m
distance(0, j) = System.Math.Min(System.Threading.Interlocked.Increment(j), j - 1)
End While
Trying to write a macro to insert a hyphen at specific points in a text string depending on how long the string is or delete all text after said point.
i.e
- if 6 characters, insert a hyphen between char 4+5 or delete all text after char 4
- if 7 characters, insert a hyphen between char 5+6 or delete all text after char 5
Ideally i would love to be able to truncate the string at that point rather than hyphenate the text but i couldn't get my head around how to make it work so i decided to hyphen and then just run a find and replace '-*' to remove the unwanted characters. Can get this working on small sample sets 100-300 cells but i need the code to be able to go through workbooks with 70,000+ cells. I've tried tweaking the code to stop the memory issue but now i can't seem to get it to work.
Sub Postcodesplitter()
Dim b As Range, w As Long, c As Range, x As Long, d As Range, y As Long
For Each b In Selection
w = Len(b)
If w = 8 And InStr(b, "-") = 0 Then b = Application.WorksheetFunction.Replace(b, 15 - w, 0, "-")
For Each c In Selection
x = Len(c)
If x = 7 And InStr(c, "-") = 0 Then c = Application.WorksheetFunction.Replace(c, 13 - x, 0, "-")
For Each d In Selection
y = Len(d)
If y = 6 And InStr(d, "-") = 0 Then d = Application.WorksheetFunction.Replace(d, 11 - y, 0, "-")
Next
Next
Next
End Sub
That's the original code i put together, but it caused memory issues over 300 target cells. I'm a pretty bad coder even at the best of times but with some advice from a friend i tried this instead.
Sub Postcodesplitter()
Dim b As Range, x As Long
If (Len(x) = 6) Then
b = Application.WorksheetFunction.Replace(b, 11 - x, 0, "-")
Else
If (Len(x) = 7) Then
b = Application.WorksheetFunction.Replace(b, 13 - x, 0, "-")
Else
If (Len(x) = 8) Then b = Application.WorksheetFunction.Replace(b, 15 - x, 0, "-")
End Sub
But this just throws out errors when compiling. I feel like im missing something really simple.
Any tips?
It looks as though you want to truncate to two less than the existing number of characters, if that number is 6-8? If so, something like this:
Sub Postcodesplitter()
Dim data
Dim x as Long
Dim y as Long
data = Selection.Value
For x = 1 to ubound(data,1)
for y = 1 to ubound(data, 2)
Select Case Len(data(x, y))
Case 6 to 8
data(x, y) = left(data(x, y), len(data(x, y)) - 2)
end select
next y
next x
selection.value = data
End Sub
In VBA, I can easily pull in an sheet\range into an array, manipulate, then pass back to the sheet\range. I'm having trouble doing this in VB.Net though.
Here's my code.
Rng = .Range("a4", .Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count))
Dim SheetArray(,) As Object = DirectCast(Rng.Value(Excel.XlRangeValueDataType.xlRangeValueDefault), Object(,))
For X As Integer = 0 To SheetArray.GetUpperBound(0)
If IsNothing(SheetArray(X, 0)) Then Exit For
SheetArray(X, 6) = SheetArray(X, 3)
SheetArray(X, 7) = CDbl(SheetArray(X, 3).ToString) - CDbl(SheetArray(X, 1).ToString) - _
CDbl(SheetArray(X, 7).ToString)
For Y As Integer = 0 To 3
SheetArray(X, Y * 2 + 1) = Math.Round(CDbl(SheetArray(X, Y * 2 + 1).ToString), 3)
Next
If Math.Abs(CDbl(SheetArray(X, 7).ToString)) > 0.1 Then _
.Range(.Cells(X + 1, 1), .Cells(X + 1, 8)).Font.Color = -16776961
Next
I'm getting an error on the first If IsNothing(SheetArray(X, 0)) Then Exit For
line. It is telling me index is out of bounds of the array. Any idea why? The SheetArray object contains the data, but I just am not sure how to get to it.
In the For you have to loop from 0 to Count - 1:
For X As Integer = 0 To SheetArray.GetUpperBound(0) - 1
'...
Next
That will fix your problem.