as far as I concern, it is permissible in VBA to do the calculation larger than 15 digits which giving you no zeroes automatically after the fifteenth digit -> more accuracy.
The idea is, the calculation could be done in VBA. The wished result(1,07007000700007000007654321) can be presented in excel as a string data type through format conversion(it is just to show in Excel sheet not to be calculated)
Question:
1 + 0.07007000700007000007654321
-> Excel gives 1.07007000700007000008
Expectation: 1.07007000700007000007654321
Here are my codes:
Sub test()
Dim y As Double
Dim m As String
'cell(1,1) is where 0.07007000700007000007654321
y = 1 + Cells(1, 1)
m = CStr(y)
Cells(2, 1).Value = m
End Sub
Thanks for the time and knowledge, guys!
Use Decimal - which needs a variable declared as Variant:
Dim y As Variant
Dim m As String
'cell(1,1) is where 0.07007000700007000007654321
y = 1 + CDec(Cells(1, 1))
m = CStr(y)
' m -> "1.07007000700007000007654321"
Related
I did this code and i don't know how could i store the result (Sheets(x + 1).Cells(i, 5)), which is a column of numbers, in a variable that i want to use later in another function.
Maybe i should do a function and then add a sub to store the function.
Sub sumV40()
Dim i As Integer
Dim x
For x = 1 To Sheets.Count
For i = 1 To 10
Sheets(x + 1).Cells(i, 5) = Sheets(1).Cells(i, 1) + Sheets(x + 1).Cells(i, 1)
Next i
Next x
end sub()
So all you need to do is Dim a new Integer variable and put it on the left of an assignment operator (in this case for VBA it is the = sign). Then all you need to do is surround your entire algebraic calculation in parenthesis (although that is not necessary in this case). It looks like you're actively putting the calculated value in another cell so I broke that into a second step.
Example:
Dim i As Integer
Dim x
Dim total As Integer
For x = 1 To Sheets.Count
For i = 1 To 10
total = (Sheets(1).Cells(i, 1) + Sheets(x + 1).Cells(i, 1))
Sheets(x + 1).Cells(i, 5) = total
Next i
Next x
(I'm a straight up beginner, first month of assignments of vba)
In my assignment, I was given an excel file with 4 sheets (of which, for my question, only the first three matter). Each of those first three's names end with the date (MM/YY) (0920, 1020 and 1120 respectively). In all those sheets I have two columns - one with a minimum value, and the other with the real value.
I need to create a procedure that, with a certain input of month and year, goes to the respective sheet and calculates how many cells with the real value have a value larger than their respective minimum value.
I tried this:
Sub ArtigosArmazem()
folhas = Array("Stock final 0920", "Stock final 1020", "Stock final 1120")
For i = LBound(folhas) To UBound(folhas)
Worksheets(folhas(i)).Activate
Next
Dim n As Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = setembro Then
i = "Stock final 0920"
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
("Ano" means year, "Mês" means month and "setembro" means september in portuguese)
But it kept outputting "0" in the Message Box. Any help or tips?
If I understand the issue, then I think you need something like this using VBA.
Sub ArtigosArmazem()
Dim x as Integer
Dim y as String
Dim n as Integer
dim k as Integer
x = InputBox("Ano")
y = InputBox("Mês")
n = 0
If x = 2020 And y = "setembro" Then
Sheets("Stock final 0920").Activate
For k = 3 To 510
If Cells(k, 8) > Cells(k, 7) Then
n = n + 1
End If
Next
MsgBox(n)
End If
End Sub
With this method you have to watch out for the capitalization of "setembro". In VBA unlike Excel, "setembro" <> "Setembro".
It might be easier to use =SUMPRODUCT((H3:H510>G3:G510)*1) in each sheet instead of VBA.
This works in my version of Excel O365. I believe it will work in earlier versions as well.
In Excel, we have 3 columns with values in them Length, Width, and Height of objects. Each row stands for 1 object, now we need to find the X number of objects that fit the most together.
For Example:
Now let's say we need the 2 closest sets of values, the output should give Nbr. 1 and 2 because [abs(11-10) + abs(9-8) + abs(4-5)] is the smallest value you'll get. Here we needed to find the 2 closest but sometimes we need to find the 25 closest sets of values.
Moreover, some might find Height not important or really important so you may want to lower or heighten its importance by adding in factors F(1,2,3) with which you multiply a part of the formula:
[F1 * abs(11-10) + F2 * abs(9-8) + F3 * abs(4-5)]
I tried to find the first (second, third and so on) smallest difference in value which works for just one variable but not multiple ones at the same time with:
=INDEX(A$2:A$5002,MATCH(SMALL(ABS(B$2:B$5002-B2),2),ABS(B$2:B$5002-B2),0))
I don´t know an Excel formula to solve this problem as I want to find the X nearest combination of values.
I expect a result showing the row numbers of X objects that fit the best together.
I Created a VBA Excel code that seems to work pretty nice in finding out which value combinations fit best together. It shows the closest values and the sum of all differences to determine the combination that works best. I did remove the first row of the picture in the description though. If anyone can improve, please do.
Sub test()
Dim last_row As Long
last_row = Cells(Rows.Count, 1).End(xlUp).Row
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim m As Integer
Dim L As Integer
Dim W As Integer
Dim H As Integer
Dim AantalGelijken As Integer
Dim FL As Integer
Dim FW As Integer
Dim FH As Integer
FL = 1
FW = 1
FH = 0.8
AantalGelijken = InputBox("How many comparable sets do you need", "Number")
L = 2
W = 3
H = 4
For i = 1 To last_row
For j = 1 To last_row
If i <> j Then
Cells(j, 5).Value = FL * Abs(Cells(i, L) - Cells(j, L)) + FW * Abs(Cells(i, W) - Cells(j, W)) + FH * Abs(Cells(i, H) - Cells(j, H))
End If
Next j
For k = 1 To AantalGelijken
Cells(i, 5 + k) = WorksheetFunction.Index(Range("A1:A9999"), WorksheetFunction.Match(WorksheetFunction.Small(Range("E1:E9999"), k), Range("E1:E9999"), 0))
Cells(i, AantalGelijken + 6) = Cells(i, AantalGelijken + 6) + WorksheetFunction.Small(Range("E1:E9999"), k)
Next k
Range("E1:E9999").Clear
Next i
End Sub
`
I need to reformat a 33500 row of data in excel. I am trying to write a macro that would do this for me.
I have put some nested loop to solve the issue
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim K As Integer
Dim p As Integer
Dim c As Integer
For c = 0 To 10
For n = 5 To 10
K = 14 + 7 * (n - 5)
For i = 0 To 7
m = 14 + 8 * c
ActiveSheet.Cells(m + i, n).Select
Selection.Copy
ActiveSheet.Cells(K + i, 37).Select
ActiveSheet.Paste
Next i
Next n
Next c
I am stuck at how to get this operation done for 32500 rows
Excel's Integer has a range of values from -32,768 to 32,767 so formatting 33,500 rows might be a problem. Assuming that you are happy with how your code works, changing your variable types to Long might be a good start.
BTW, you should avoid SELECTing cells as it slows down the code and can lead to errors. You can easily copy and paste between cells using soemthing like
Cells(m + i, n).Copy Destination:=Cells(K + i, 37)
Revised the code according to the comment and now working like a charm. Thank you so much
Dim i As Integer
Dim m As Integer
Dim n As Integer
Dim K As Integer
Dim p As Integer
For i = 0 To 121
m = 14
For n = 5 To 35
ActiveSheet.Range(Cells(m + i * 8, n), Cells(m + i * 8 + 7, n)).Copy
Range("AK" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlValues
Next n
Next i
End Sub
I am getting an error at the subroutine called NLRegress. I think the array types are not the same that are being multiplied in the first call in Sub NLRegress. The Z matrix is the following array [1,0.2,0.04: 1,0.5,0.25: 1,0.8,0.64: 1,1.2,1.44: 1,1.7,2.89: 1,2,4]
This is my code :
Option Explicit
Option Base 1
Sub Main()
Dim x() As Double, y() As Double, n As Integer, p As Integer, _
a() As Double, syx As Double, r2 As Double, m As Integer, _
yf() As Double, Z() As Double
Dim i As Integer, k As Integer
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
For k = 1 To 100
If Worksheets("Sheet1").Range("B2").Cells(k, 1).Value <> "" Then
p = p + 1 'counts the number of data points
Else
Exit For
End If
Next k
If p = n Then
p = n
ReDim yf(n)
Else: MsgBox ("Unequal number of x and y values")
End If
ReDim x(n)
ReDim y(n)
For i = 1 To n 'Read data for matrix x
x(i) = _
Worksheets("Sheet1").Range("A2").Cells(i, 1).Value
Next
For i = 1 To n 'Read data for matrix y
y(i) = _
Worksheets("Sheet1").Range("B2").Cells(i, 1).Value
Next
m = Worksheets("Sheet1").Range("E2").Value
ReDim a(m + 1)
Call BuildZP(x, Z, n, m)
Call NLRegress(Z, y, a, n, m)
Call MultiplyMatrixByVector(Z, a, yf)
End Sub
Sub Fitted_Data(yf, a, x, n)
Dim q As Integer
For q = 1 To n
yf(q) = a(1) + a(2) * x(q) + a(3) * x(q) ^ 2
Worksheets("Sheet1").Range("C2").Cells(q, 1).Value = yf(q)
Next
End Sub
Sub NLRegress(Z, y, a, n, m)
Dim er As Double, tol As Double, ZT() As Double, ZTZ() As Double, ZTZI() As Double, ZTY() As Double
er = 0
tol = 0.0001
ReDim ZT(m + 1, n)
Call TransposeMatrix(Z, ZT)
Call MultiplyMatrices(ZT, Z, ZTZ)
Call MatrixInverse(ZTZ, ZTZI, m + 1, tol, er)
Call MultiplyMatrixByVector(ZT, y, ZTY)
Call MultiplyMatrixByVector(ZTZI, ZTY, a)
End Sub
Sub BuildZP(x, Z, n, m)
Dim i As Integer, j As Integer
ReDim Z(n, m + 1)
For i = 1 To n
For j = 1 To m + 1
Z(i, j) = x(i) ^ (j - 1)
Next j
Next i
End Sub
This answer will probably not solve your issue (see my comment) - but let me nonetheless give you a few best practices that might make programming in VBA easier and maybe prevent such errors in the first place - in your next project.
Try to incorporate the following into your programming
Proper indenting: Every time you use a programming structure the encloses another block of code - such as For, If, While, indent the enclosed code block one level further. E.g. your first few lines of code should look like
For k = 1 To 100
If Worksheets("Sheet1").Range("A2").Cells(k, 1).Value <> "" Then
n = n + 1 'counts the number of data points
Else
Exit For
End If
Next k
You are already using Option Explicit, which is great. However, you should also properly Dim each variable in the procedure/function calls - e.g. Sub Fitted_Data(yf as Double, ...)
You're using a total of 12 variables in your main procedure. This is a very strong indicator, that your routine is doing too much! Better break it up in to small sub routines and maybe use a few module wide variables - see the example below.
The variable names are absolutely meaningless - which makes it hard to debug for you - and almost impossible for outsiders to understand what your code is doing.
AFAIK your first 25 rows "only" assign two ranges to an array and check if these are the same size. Using the syntax x = StartRange.Resize(NumberOfRows).Cells you can achieve this with much less code - and it executes much faster.
Same thing goes finding the first blank row - instead of looping, use StartRange.End(xlDown) - this will return you the last non-blank row!
Also, if you want to assign an array to a range, it works the other way round, too: StartRange.Resize(NumberOfRows) = x.
Hardcoding Worksheets("Sheet1").Range("A2") will lead to problems when the user changes the worksheet structure, e.g. rename the sheet or insert rows/columns. Better assign the cells A2 and B2 names, e.g. StartVector1 and then access them with Range("StartVector1"). Much more robust - and your code is less cluttered
"Don't repeat yourself" (DRY). If you see yourself doing the same code twice, make it a separate procedure - e.g your code to count the number of data points
No need to use Call Sub(x, y) - Sub x, y is equivalent to it in VBA
Excel function can also be used in VBA. This is especially handy for matrix function. E.g. to transpose an array, you could use this code: transposedX = worksheetFunctions.Transpose(x)
Here's the code structure with the first few
Option Explicit
Private mVec1() As Double 'Better give a better name representing the target content of variable
Private mVec2() As Double 'I use m as a prefix to indicate module wide scoped variables
Public Sub SubDoingSomething() 'Use a name that tells the reader what the sub does
LoadVectors
BuildZP Z, n, m 'use proper variable names here
NLRegress Z, y, a, n, m 'and maybe use some more module wide variables that you don't need to pass
MultiplyMatrixByVector Z, a, yf
End Sub
Private Sub LoadVectors()
Dim count1 As Long, count2 As Long
count1 = GetRowLength(Range("StartVector1"))
count2 = GetRowLength(Range("StartVector2"))
If count1 <> count2 Then
MsgBox ("Unequal number of x and y values")
End
End If
mVec1 = Range("StartVector1").Resize(count1).Cells
mVec2 = Range("StartVector2").Resize(count2).Cells
End Sub
Private Function GetRowLenght(rng As Range)
If rng.Offset(1) = "" Then
GetRowLength = 1
Else
GetRowLength = rng.End(xlDown).Row - rng.Row + 1
End If
End Function