Input:
G F V S P M
10 1 1 1 1 a
10 1 1 1 1 b
10 1 2 1 1 c
10 2 1 1 1 c
11 1 1 1 1 d
11 1 1 2 1 d
11 1 1 2 1 e
Output should be:
G F V S P M
10 1 1 1 1 a, b
10 1 2 1 1 c
10 2 1 1 1 c
11 1 1 1 1 d, e
11 1 1 2 1 d, e
Public Function Test()
Dim sqlCON As New ADODB.Connection
Dim sqlREC As New ADODB.Recordset
Dim sqlSTR As String
Dim sqlSTR2 As String
Dim newWB As Workbook
Set newWB = ActiveWorkbook
With sqlCON
.Provider = "Microsoft.ACE.OLEDB.12.0;"
.ConnectionString = "Data Source='" & newWB.FullName & "';Extended Properties=""Excel 12.0 Xml;HDR=Yes;IMEX=1"";"
.Open
End With
sqlSTR = "SELECT G, F, V, S, P, M " & _
"FROM [Sheet1$];"
Set sqlREC = sqlCON.Execute(sqlSTR)
If sqlREC.BOF = False And sqlREC.EOF = False Then
getAD = sqlREC.GetRows
Else
getAD = Empty
End If
Set sqlREC = Nothing
sqlCON.Close
In the SELECT section of the code, I have already tried FOR XML PATH, STRING_AGG and GROUP_CONCAT, but had no success, it seems these functions are not supported in VBA.
The "ID" of the row is a combination of all the columns, where the leading column is V, for each V (combined with the other columns) we have a combination of M.
Does someone have a clue on how I can get the desired output?
Related
I have a table like this:
MAName feldtext
------------------
karl fieldtext1
karl fieldtext2
karl fieldtext1
karl fieldtext3
karl fieldtext4
karl fieldtext2
karl fieldtext5
karl fieldtext3
karl fieldtext3
susi fieldtext1
susi fieldtext4
john fieldtext2
john fieldtext5
john fieldtext5
and I need:
MAName fieldtext1 fieldtext2 fieldtext3 fieldtext4 fieldtext5 FehlerJeMA
karl 2 2 3 1 1 9
susi 1 0 0 1 0 2
john 0 1 0 0 2 3
The columns fieldtext can go from fieldtext1 to fieldtextn, it's dynamic, depending on query.
I was looking here for solutions and found, so my approach:
Dim dt2 As New DataTable
Dim nn As Integer = 0
Dim Zeile As DataRow
dt2.Columns.Add("MAName")
' fieldtext distinct
Dim query2 = (From dr In (From d In newTable2.AsEnumerable Select New With {.feldtext1 = d("feldtext")}) Select dr.feldtext1 Distinct)
For Each Feldtext In query2
dt2.Columns.Add(Feldtext)
Next
column = New DataColumn()
column.DataType = System.Type.GetType("System.Int32")
column.ColumnName = "FehlerJeMA"
dt2.Columns.Add(column)
' MAName distinct
Dim query3 = (From dr In (From d In newTable2.AsEnumerable Select New With {.MAName2 = d("MAName")}) Select dr.MAName2.ToString.ToLower Distinct)
For Each Mitarbeiter In query3
Zeile = dt2.NewRow()
Zeile(0) = Mitarbeiter.ToString.ToLower
MA2 = Mitarbeiter.ToString.ToLower
nn = 1
For Each colName2 In query2
Fehler2 = colName2
Dim AnzahlFehler As String = (From row In newTable2.Rows Select row Where row("MAName").ToString.ToLower = MA2 And row("feldtext") = Fehler2).Count
If AnzahlFehler = 0 Then
AnzahlFehler = ""
End If
Zeile(nn) = AnzahlFehler
nn += 1
If AnzahlFehler <> "" Then
FehlerJeMA += CInt(AnzahlFehler)
End If
Next
Zeile(nn) = FehlerJeMA
dt2.Rows.Add(Zeile)
Next
This works, but is very slow...
It could be the case that in my table has more than 10.000 rows...
So my question is: what is fastest approach to get the result?
Is it some kind of cross table with linq? Other approaches?
In C# you will be able to use the code, try to translate it for your problem:
var pivotData = data.GroupBy(x => new {x.MAName, x.feldtext}, (key, group) => new { MAName = key.Column1, feldtext = key.Column2, count = group.Count() });
I'm new in vb.net programming, and i want to read a 2d array from a file. I searched a lot and i can't figure out how can i do that. There is the input file :
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
1 1 1 1 1 1 1 1 1 1 1 1 1
And here is the code part :
Dim map As Integer(,)
Dim reader As StreamReader
reader = IO.File.OpenText(folder + "\harta\harta.txt")
Dim linie As String, i, j As Integer
For i = 0 To 10
For j = 0 To 12
linie = reader.ReadLine()
map(i, j) = linie.Substring(j, linie.IndexOf(" ")) 'here is my problem'
Next j
Next i
reader.Close()
When i run the code, i get the following error:
An unhandled exception of type 'System.NullReferenceException' occurred in WindowsApplication1.exe
Edit:
I tried another method :
Dim reader As IO.StreamReader
reader = IO.File.OpenText(folder + "\harta\harta.txt")
Dim linie As String, i, j As Integer
For i = 0 To 10
linie = reader.ReadLine
Dim parametrii As String() = linie.Split(" ")
Dim parametru As String
j = 0
For Each parametru In parametrii
map(i, j) = parametru 'i get the same error here'
j += 1
Next
Next i
I really dont know what is wrong.
Here you are, and I fixed some problems that you can see by comparing between this code and yours :
Dim map(10, 12) As Integer
Dim reader As IO.StreamReader
reader = IO.File.OpenText("harta.txt")
Dim linie As String, i, j As Integer
For i = 0 To 10
linie = reader.ReadLine.Trim
For j = 0 To 12
map(i, j) = Split(linie, " ")(j)
Next j
Next i
reader.Close()
You are reading too many lines...if there is no line to read, a Null reference is returned by ReadLine.
You need to ReadLine from 0 to 10, and for each line, use split to get the column values.
This part is currently returning a null reference:
linie = reader.ReadLine()
And when you attempt this:
linie.IndexOf(" ")
It causes an exception. The linie variable is null.
I want to count the number of spaces and characters inputted in a textbox field.
Example
textbox1.text - " 1 2 3 4 5 6 7 a b c"
I want to count the number of spaces and the characters
Then the result must be..
Dim spaces as integer, char as integer
spaces = 10 , char = 10
Dim spaceCount, lettercount As Integer
spaceCount= 0
lettercount = 0
Dim s As String = " 1 2 3 4 5 6 7 a b c"
For Each c As Char In s
If c = " " Then
spaceCount+= 1
Else
lettercount += 1
End If
Next
MsgBox(charcount)
MsgBox(lettercount)
For Each will iterate each character within the string then it will check whether c is a space or not. if it is a space then increment the spaceCount else increment the lettrtCount
You can do as you want in a sort way.
Try it
Dim count As Integer = 0
textbox1.text = " 1 2 3 4 5 6 7 a b c"
count = textbox1.text.Split(" ").Length -1
Dim longstring As String = "aab c d e"
Dim TotalLength As Integer = longstring.Length
Dim TotalSpaces() As String = Split(longstring, " "
Dim TotalChars As Integer = TotalLength - (TotalSpaces.Length - 1)
For example,
The table has 3 rows and 3 columns:
Name Age Gender
Peter 25 M
John 29 M
Alex 25 M
And I want to query the table and get
Name Age Gender
Peter 25 M
John 29
Alex
The method I have tried:
SELECT DISTINCT Name,Age,Gender FROM table
The output is still
Name Age Gender
Peter 25 M
John 29 M
Alex 25 M
How to achieve the table that there is no redundant entries for every field? Thanks.
Thanks for the help from all of you, especially the help from donPablo.
Here's my VBA code to achieve that. Since I am totally new to VBA, the code might not be very clean and efficient. But at least it works.
Option Compare Database
Sub ReadDistinctValue()
Dim d As Database
Dim rs As Recordset
Dim FN As Field, Age As Field, Sex As Field
Set d = CurrentDb()
Set rs = d.OpenRecordset("Table1")
Set FN = rs.Fields("FN")
Set Age = rs.Fields("Age")
Set Sex = rs.Fields("Sex")
d.Execute "CREATE TABLE Table4 (FN Text,Age Text,Sex Text)"
While Not rs.EOF
If CheckFN(FN) = False Then
Call WriteFN(FN)
End If
If CheckAge(Age) = False Then
Call WriteAge(Age)
End If
If CheckSex(Sex) = False Then
Call WriteSex(Sex)
End If
rs.MoveNext
Wend
rs.Close
End Sub
Function CheckFN(FN As Field) As Boolean
Dim d As Database
Dim rs_new As Recordset
Dim FN_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set FN_new = rs_new.Fields("FN")
CheckFN = False
Do While Not rs_new.EOF
If FN_new = FN Then
CheckFN = True
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
Function WriteFN(FN As Field)
Dim d As Database
Dim rs_new As Recordset
Dim FN_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set FN_new = rs_new.Fields("FN")
If Not rs_new.EOF Then
rs_new.MoveFirst
End If
Do While True
If rs_new.EOF Then
rs_new.AddNew
FN_new = FN
rs_new.Update
Exit Do
End If
If IsNull(FN_new.Value) Then
rs_new.Edit
FN_new = FN
rs_new.Update
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
Function CheckAge(Age As Field) As Boolean
Dim d As Database
Dim rs_new As Recordset
Dim Age_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set Age_new = rs_new.Fields("Age")
CheckAge = False
Do While Not rs_new.EOF
If Age_new = Age Then
CheckAge = True
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
Function WriteAge(Age As Field)
Dim d As Database
Dim rs_new As Recordset
Dim Age_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set Age_new = rs_new.Fields("Age")
If Not rs_new.EOF Then
rs_new.MoveFirst
End If
Do While True
If rs_new.EOF Then
rs_new.AddNew
Age_new = Age
rs_new.Update
Exit Do
End If
If IsNull(Age_new.Value) Then
rs_new.Edit
Age_new = Age
rs_new.Update
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
Function CheckSex(Sex As Field) As Boolean
Dim d As Database
Dim rs_new As Recordset
Dim Sex_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set Sex_new = rs_new.Fields("Sex")
CheckSex = False
Do While Not rs_new.EOF
If Sex_new = Sex Then
CheckSex = True
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
Function WriteSex(Sex As Field)
Dim d As Database
Dim rs_new As Recordset
Dim Sex_new As Field
Set d = CurrentDb()
Set rs_new = d.OpenRecordset("Table4")
Set Sex_new = rs_new.Fields("Sex")
If Not rs_new.EOF Then
rs_new.MoveFirst
End If
Do While True
If rs_new.EOF Then
rs_new.AddNew
Sex_new = Sex
rs_new.Update
Exit Do
End If
If IsNull(Sex_new.Value) Then
rs_new.Edit
Sex_new = Sex
rs_new.Update
Exit Do
End If
rs_new.MoveNext
Loop
rs_new.Close
End Function
By naming the three columns, you are retrieving distinct combinations of that set of values.
If you want lists of distinct values, name each individually in a select.
SELECT DISTINCT Name FROM table
SELECT DISTINCT Age FROM table
SELECT DISTINCT Gender FROM table
If you are trying to get them to display as you have in your example, that will have to be accomplished by some GUI functionality. SQL database engines are not good at display trickery, just handling data.
I have expanded the table values a little, just to see what would happen --
FN Age Sex
Alice 28 F
Ben 19 M
Charles 33 M
Doug 23 M
Elaine 21 F
Frank 25 M
Gwen 28 F
Helen 33 F
Alice 17 F
Ben 21 F
Then I developed a single query for FN, and later generalized to all three fields --
The clue is to sequence # each FN/AGE/SEX and then join on that seq#--
SELECT
AB.fn,
CD.age,
EF.sex
FROM
((SELECT A.fn, Count(B.fn) AS CNTfn
FROM
(SELECT DISTINCT fn FROM table1) AS A,
(SELECT DISTINCT fn FROM table1) AS B
WHERE B.fn <= A.fn
GROUP BY A.fn) AS AB
LEFT JOIN
(SELECT C.age, Count(D.age) AS CNTage
FROM
(SELECT DISTINCT age FROM table1) AS C,
(SELECT DISTINCT age FROM table1) AS D
WHERE D.age <= C.age
GROUP BY C.age) AS CD
ON AB.cntfn = CD.cntage)
LEFT JOIN
(SELECT E.sex, Count(F.sex) AS CNTsex
FROM
(SELECT DISTINCT sex FROM table1) AS E,
(SELECT DISTINCT sex FROM table1) AS F
WHERE F.sex <= E.sex
GROUP BY E.sex) AS EF
ON AB.cntfn = EF.CNTsex;
This gives the results desired --
FN AGE SEX
Alice 17 F
Ben 19 M
Charles 21
Doug 23
Elaine 25
Frank 28
Gwen 33
Helen
I changed the Sex in my sample table, and added to the following as the first sequencing of the un-Distinct whole table and changed the ON... to XZ.cntall ...
(SELECT X.FN & X.AGE & X.SEX, Count(*) AS CNTall
FROM
(SELECT DISTINCT FN, AGE, SEX FROM table1) AS X,
(SELECT DISTINCT FN, AGE, SEX FROM table1) AS Z
WHERE Z.FN & Z.AGE & Z.SEX <= X.FN & X.AGE & X.SEX
GROUP BY X.FN, X.AGE, X.SEX) as XZ
and now get these results
fn age sex
Alice 17 M
Ben 19 N
Charles 21 O
Doug 23 P
Elaine 25 Q
Frank 28 R
Gwen 33 W
Helen X
Y
Z
There is probably an SQL solution for this. I am constantly amazed at what can be done. However, my answer is that this is a perfect application for VBA.
Hi below is the data sample for chart data which I read from URL
ARRAY ' ' 3 8
Y
25 75 100 125 150 175 200 225
'A' 3 8 6 7 5 3 2 7
'B' 1 9 7 8 4 7 2 5
'C' 8 7 3 6 56 9 111 8
Now in this I want to save this data into a csv file as below
Time A B c
25 3 1 8
75 8 9 7
100 6 7 3
125 7 8 9
150 5 4 56
175 3 7 9
200 2 2 111
225 7 5 8
Actually I have to first read the data into an array in which each element will contain one line of the data file, Now I will have to split the each element by space and store it in a two dimensional array, now for each ith index of each array I have to create a coma separated line then put "\n" at the end of line , and at last save this to a csv file . I don't know much about the syntax of vb-script and classic asp that's why I am facing this problem . Please help me
To get you started:
Sub doReOrder(sFSpecI, sFSpecO, sCol1)
Dim oTS : Set oTS = goFS.OpenTextFile(sFSpecI)
Dim sData : sData = oTS.ReadLine() ' ARRAY ' ' 3 8
Dim aParts : aParts = Split(sData, " ")
Dim nCols : nCols = CByte(aParts(3)) ' Count vs UBound vs Data!
Dim nRows : nRows = CByte(aParts(4))
Dim nRows2 : nRows2 = nRows + 1
oTS.SkipLine ' Y
' get table in one string, prepend col1 name, clean '
sData = "'" & sCol1 & "' " & Replace(oTS.ReadAll(), vbCrLf, " ")
sData = Trim(Replace(sData, "'", """"))
' get table in flat array
aParts = Split(sData, " ")
oTS.Close
Set oTS = goFS.CreateTextFile(sFSpecO, True)
' WScript.Echo Join(aParts, "|")
ReDim aData(nCols) ' hold one (new) row to prep for Join
Dim nRow
For nRow = 0 To nRows
Dim nCol
For nCol = 0 To nCols
' magic column hopping
aData(nCol) = aParts(nRow + nCol * nRows2)
Next
oTS.WriteLine Join(aData, ",")
Next
oTS.Close
End Sub
Test:
Dim sFSpecI : sFSpecI = "..\Data\f1.txt"
Dim sFSpecO : sFSpecO = "..\Data\f1.csv"
Dim sCol1 : sCol1 = "Time" ' dangerous - possibly reserved in SQL
WScript.Echo goFS.OpenTextFile(sFSpecI).ReadAll()
doReOrder sFSpecI, sFSpecO, sCol1
WScript.Echo goFS.OpenTextFile(sFSpecO).ReadAll()
Output:
ARRAY ' ' 3 8
Y
25 75 100 125 150 175 200 225
'A' 3 8 6 7 5 3 2 7
'B' 1 9 7 8 4 7 2 5
'C' 8 7 3 6 56 9 111 8
"Time","A","B","C"
25,3,1,8
75,8,9,7
100,6,7,3
125,7,8,6
150,5,4,56
175,3,7,9
200,2,2,111
225,7,5,8