I was trying to export the Multi-valued field but couldn't able to achieve it. i tried Ubound to export but the scenario is I need the 1st value in 1st row and 2nd value in 2nd row vice versa. Please help me to solve this. I'm using excel application to export the data.
Thanks in advance.
ForAll b In fieldList
If UBound(doc.getitemvalue(b)) <1 Then
worksheet.cells(i,j).value =doc.getitemvalue(CStr(b))
Else
'Join(doc.getitemvalue(CStr(b)),Chr(10))
worksheet.cells(i,j).value =Join(doc.getitemvalue(CStr(b)),Chr(10))
End If
End Forall
Create a loop that goes through all the values for each field by index ("x" in my code sample). Use x again to offset the row value.
You will have a problem that each fieldName's values will be overwritten in the spreadsheet, because i and j are always the same, so if you have more than one fieldName in your fieldList you will need to do something about that too. In my example, I have incremented j for each fieldName so that they will be in different spreadsheet columns
ForAll fieldName In fieldList
For x = LBound(doc.getitemvalue(fieldName)) to Ubound(doc.getitemvalue(fieldName))
worksheet.cells(i + x, j).value = doc.getitemvalue(fieldName)(x)
Next
j = j + 1
End Forall
Alternative version to achieve what you ask in your comment:
ForAll fieldName In fieldList
For x = LBound(doc.getitemvalue(fieldName)) to Ubound(doc.getitemvalue(fieldName))
worksheet.cells(i, j + x).value = doc.getitemvalue(fieldName)(x)
Next
i = i + 1
End Forall
Lets assume the following document:
Fieldname
Value 0
Value 1
Value 2
FirstField
Value0-First
SecondField
Value0-Second
Value1-Second
Value2-Second
ThirdField
Value0-Third
Value1-Third
Solution 1:
If you want the result to look like this
FirstField
SecondField
ThirdField
Value0-First
Value0-Second
Value0-Third
Value1-Second
Value1-Third
Value2-Second
Then you use the following code:
cellY = 2
cellX = 1
Forall fieldName in fieldNameList
For y = 0 to ubound( doc.GetitemValue( fieldName ) )
worksheet.cells(cellY + y, cellX).value = doc.GetitemValue( fieldName )(y)
Next
cellX = cellX + 1
End Forall
Solution 2: If you want the result to look like this
Fieldname
Value 0
Value 1
Value 2
FirstField
Value0-First
SecondField
Value0-Second
Value1-Second
Value2-Second
ThirdField
Value0-Third
Value1-Third
Then you use the following code:
cellY = 1
cellX = 2
Forall fieldName in fieldNameList
For x = 0 to ubound( doc.GetitemValue( fieldName ) )
worksheet.cells(cellY, cellX+x).value = doc.GetitemValue( fieldName )(x)
Next
cellY = cellY + 1
End Forall
Solution 3:
If you want the result to look like this
All fields
FirstField
Value0-First
SecondField
Value0-Second
Value1-Second
Value2-Second
ThirdField
Value0-Third
Value1-Third
Then you use the following code:
cellY = 1
cellX = 1
Forall fieldName in fieldNameList
worksheet.cells(cellY, cellX).value = fieldName
For y = 0 to ubound( doc.GetitemValue( fieldName ) )
cellY = cellY + 1
worksheet.cells(cellY, cellX).value = doc.GetitemValue( fieldName )(y)
Next
cellY = cellY + 1
End Forall
doc.getitemvalue(CStr(b)) always returns a variant array, even when the Ubound is less than one.
The code in your Then clause needs to dereference the 0th entry of the array:
worksheet.cells(i,j).value =doc.getitemvalue(CStr(b))(0)
Related
I cannot extract the postal/zip code of a given address cell that comes like this :
"108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS".
I have used :
=RECHERCHE(9^9;--("0"&STXT(A2;MIN(CHERCHE({0.1.2.3.4.5.6.7.8.9};A2&"0 123456789"));LIGNE($1:$100))))
Which sometimes works, sometimes not depending on the street number starting the address (here "108,").
The problem is the space of the pattern "37 170". I would like to remove the blank space in the pattern. Is there a regex way to search this pattern "## ###", and then to remove this poisonous blank space?
Thank you for your tricks.
I have tried this piece of code :
Function toto(r, Optional u = 0)
Application.Volatile
Dim i%, j%, adr$, cp$, loca$, x
x = Split(r)
For i = 0 To UBound(x)
If x(i) Like "#####" Then Exit For
Next
If i > UBound(x) Then
adr = r.Value 'facultatif
Else
cp = x(i)
For j = 0 To i - 1: adr = adr & x(j) & " ": Next
adr = Left$(adr, Len(adr) + (Len(adr) > 1))
For j = i + 1 To UBound(x): loca = loca & x(j) & " ": Next
loca = Left$(loca, Len(loca) + (Len(loca) > 1))
End If
x = Array(adr, cp, loca)
If 0 < u And u < 4 Then toto = x(u - 1) Else toto = x
End Function
The above code works fine for splitting addresses including street number, zip code, and city name. But it does not work when the zip code is ## ### = 2 digit integer - space - 3 digit integer.
Edit: 01 June 2021
Since it seems my question is not clear enough, let's rephrase :
Given an Excel worksheet containing in each cell of column A, from saying A1 down to A10000, complete addresses like this one :
"2 rue Rene cassin Centre Commercial Châlon 2 Sud 71 100 CHALON SUR SAONE"
or this one :
"15, Rue Emile Schwoerer 68 000 COLMAR"
Where "71 100" and "68 000" are a zip code in incorrect format because of the extra space between the 2 first digits and 3 last digits.
I need to split the Ai cell content in order to obtain :
in cell Bi : the text (street, etc.) placed left before the 2 first digits of the "wrong" zip code,
in cell Ci : the zip code with its correct format ("71100" and not "71 100"),
in cell Di : the text (city name) after the zip code.
It's a kind of left and right extraction around the zip code.
The above code that I have posted does not work.
In order to obtain the correct zip code format, I have tried the regex following function :
Function FindReplaceRegex(rng As Range, reg_exp As String, replace As String)
Set myRegExp = New RegExp
myRegExp.IgnoreCase = False
myRegExp.Global = True
myRegExp.Pattern = reg_exp
FindReplaceRegex = myRegExp.replace(rng.Value, replace)
End Function
But I am unable to determine the correct regular expression pattern to get rid of the space in the zip code.
PEH gave me the following pattern :
(.*)([0-9]{2} ?[0-9]{3})(.*)
When using the function, I have tried to define the replacement pattern by:
(.*)([0-9]{2}[0-9]{3})(.*)
But it would not work. Hope this will clarify my question.
Any idea is welcome. Thanks
If these input strings always have the same pattern, try:
=CONCAT(FILTERXML("<t><s>"&SUBSTITUTE(A1," ","</s><s>")&"</s></t>","//s[.*0=0]"))
Depending on your needs/edge-cases, you could add more xpath expressions.
If this is VBA, I have a fix for you (please forgive the crappy naming convention, I'm scribbling this down in work while waiting for SQL to refresh):
Sub test1()
a0 = Cells(1, 1) 'Get the text, in this case "108, avenue du Grand Sud 37 170 CHAMBRAY les TOURS"
aa = Replace(a0, ",", " ") 'Make all delimiters of same type, so removing commas, you may need to add more replace work here?
ab = Application.Trim(aa) 'Reduce all whitespace to single entries, i.e. " " rather than " "
ac = Split(ab, " ", -1) 'Now split by that single whitespace entry
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1 'Step through each entry in our "split" list
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
End Sub
edit 2021-06-01:
The above will generate a list (txt) of all the entries within your address. You can then reassemble if you wish, or extract out the postcode only.
If you want it as a function, then it would be:
Public Function getPostcode(a0)
aa = Replace(a0, ",", " ")
ab = Application.Trim(aa)
ac = Split(ab, " ", -1)
Dim txt()
i2 = 0
lastIsNumeric = False
For i1 = 0 To UBound(ac) - 1
If IsNumeric(ac(i1)) = True And IsNumeric(ac(i1 + 1)) = True Then
'Two numbers back to back, join
ReDim Preserve txt(i2)
txt(i2) = ac(i1) + ac(i1 + 1)
i2 = i2 + 1
i1 = i1 + 1
Else
'Not two numbers back to back, don't join
ReDim Preserve txt(i2)
txt(i2) = ac(i1)
i2 = i2 + 1
End If
Next i1
If IsNumeric(ac(UBound(ac))) = False Then
'Need to add last entry to txt()
ReDim Preserve txt(UBound(txt) + 1)
txt(UBound(txt)) = ac(UBound(ac))
End If
'Re-assemble string for return
rtnTxt = ""
For i1 = 0 To UBound(txt)
rtnTxt = rtnTxt & " " & txt(i1)
Next i1
getPostcode = rtnTxt
End Function
I have a list of words and I would like to find all symmetric words and some how put value 1 for each of them (see the picture).
This does the trick:
=1*(A1=CONCAT(MID(A1,LEN(A1)-SEQUENCE(1,LEN(A1),0),1)))
It reads the string in a cell backwards using MID and SEQUENCE, and compares the CONCAT result with the original to see if it is the same, i.e. the string is symmetric.
Multiplying by 1 forces the Boolean into an integer.
With VBA. This assumes that a single character is symmetric:
Public Function Sym(s As String) As Long
Dim L As Long, L2 As Long
Dim p1 As String, p2 As String
L = Len(s)
L2 = Int(L / 2)
Sym = 0
If L Mod 2 = 0 Then
' even
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 1))
If p1 = p2 Then
Sym = 1
End If
Else
' odd
p1 = Mid(s, 1, L2)
p2 = StrReverse(Mid(s, L2 + 2))
If p1 = p2 Then
Sym = 1
End If
End If
End Function
This will handle both an even or odd number of characters.
EDIT#1:
Simply:
Public Function Sym(s As String) As Long
Sym = 0
If s = StrReverse(s) Then Sym = 1
End
With Microsoft365, try:
Formula in B1:
=EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
Formula in C1:
=--EXACT(A1,CONCAT(MID(A1,SEQUENCE(LEN(A1),,LEN(A1),-1),1)))
If you are working in a version without CONCAT() it will get significatly more verbose, but still possible:
=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1)
This, again, can be wrapped to return either 1 or 0 if you prefer that over the boolean results:
=--(=SUMPRODUCT(--EXACT(MID(A1,ROW(A$1:INDEX(A:A,LEN(A1))),1),MID(A1,(LEN(A1)+1)-ROW(A$1:INDEX(A:A,LEN(A1))),1)))=LEN(A1))
The problem is pretty straight forward: convert the string representation into a number representing minutes. The only problem is that my code only works when I type the HH:MM:SS within a set of "". If the quotes are not included, the code runs but I get a #value error inside the cell in Excel. I figured this has to do with the length. With/without the quotes included, the code goes to the first index of the converted character array (or I should say the 0th). Here is my code:
Public Function TimeToDbl(val As String)
'Convert string into character array
Dim buff() As String
ReDim buff(Len(val) - 1)
For i = 1 To Len(val)
buff(i - 1) = Mid$(val, i, 1)
Next
'Separate hours,minutes,seconds
Dim h, m, s As Double
h = 0
m = 0
s = 0
For i = 1 To 2
h = (h * 10 ^ (i - 1)) + CInt(buff(i))
Next i
For i = 4 To 5
m = (m * 10 ^ (i - 4)) + CInt(buff(i))
Next i
For i = 7 To 8
s = (s * 10 ^ (i - 7)) + CInt(buff(i))
Next i
'Combine values centering minutes
s = s * 0.017
h = h * 60
m = h + m + s
TimeToInt = m
End Function
When passing a string with quotes, the quotes are included in the string. When the string is copied to an array, arr[0] becomes ". When passed without quotes, the text is still of type "string".
make a small change in the algorithm for h,m, and s shown below:
For i = 0 To 1
h = (h * (10 ^ i) + CInt(buff(i)))
Next i
I have 1 string and 1 cell array of srings :
F = 'ABCD'
R = {'ACBD','CDAB','CABD'};
I would like to compare the string F with all of the strings in R as follows: F(1)='A' and R{1}(1)='A', we will count 1 ( because they have the same value 'A') , F(2)='B' and R{1}(2)='C' we will count 0 ( because they have different values)...and like that until the end of all strings.
We will get same = 2 , dif = 2 for this 'ABCD' and 'ACBD'.
How can I compare F with all the elements in R in the above rule and get the total(same) and total(dif) ?
Assuming all strings in R has the same length as F you can use cellfun:
same = cellfun( #(r) sum(F==r), R )
Results with
2 0 1
That is, the same value per string in R. If you want dif:
dif = numel(F)-same;
If you want the totals:
tot_same = sum(same);
tot_dif = sum(dif);
option explicit
dim r, res, num
num= cint(inputbox("Enter the number"))
do while(num > 0)
r= num mod 10
num= num\10
res= res & r
loop
msgbox res
Well this is the code, now my question is this works perfectly fine for input 1234, well if the input is 0123 it just prints 321 which is wrong.It needs to print 3210.
I am unable to figure out, tried a lot but in vain, any help would be appreciated
Thanks and Regards
You must decide whether you want to reverse strings or numbers (accidentially represented as decimals). If you want to reverse strings, you should
not convert the (string) input to a number/integer
use string ops: Mid() for reading, concatenation & for building
Added: In (demo/not production) code:
Option Explicit
Function rev(s)
Dim p
For p = Len(s) To 1 Step -1
rev = rev & Mid(s, p, 1)
Next
End Function
Dim s
For Each s In Array("1234", "0123")
WScript.Echo s, rev(s)
Next
output:
1234 4321
0123 3210
str = Inputbox("Enter the number")
rev=""
Set regx = New RegExp
regx.Global = True
regx.IgnoreCase = True
regx.Pattern = ".{1}"
Set colchars= regx.Execute(str)
For i = 0 To colchars.Count-1
rev= colchars.Item(i)&rev
Next
MsgBox rev
String reverse program without using Reverse String function & Mid function.
str=inputbox("Enter the string: ")
str1=len(str)
a=Left(str,1)
for i=1 to str1
str2=Left(str,i)
if len(str2)>1 then
str3=Right(str2,1)&temp
temp=str3
end if
next
msgbox temp&a
Try this:
Dim num, rev
num = inputbox("Enter a number")
If Len(num)=4 Then
rev = rev*10 + num mod 10
num = num/10
num = left(num,3)
rev = rev*10 + num mod 10
num = num/10
num = left(num,2)
rev = rev*10 + num mod 10
num = num/10
num = left(num,1)
rev = rev*10 + num mod 10
msgbox "Reverse Order of the number is "&rev
Else
msgbox "Number, you entered is not a 4 digit number"
End If