Jacek Kotowski's toolbox.

czwartek, 16 kwietnia 2015

Ekwiwalenty MS SQL w Accesie

bez Over, Partition by? Odp. znalazlem tutaj: http://stackoverflow.com/questions/439138/running-total-by-grouped-records-in-table Kolejne, jak sobie poradzic bez INTERSECT... http://stackoverflow.com/questions/337158/how-can-i-implement-sql-intersect-and-minus-operations-in-ms-access

wtorek, 7 kwietnia 2015

SQL w Excelu Cz.3: Odpowiednik MS SQL ROLLUP? Voila.

Mój eksperyment. TableA zawiera nieuporządkowaną ofertę po analizie cen. TableB zawiera opisy grup. Chcę uzyskać tabelę oferty z pogrupowanymi i podsumowanymi kodami (na podst. pierwszych trzech liter). Każda grupa powinna zaczynać się od wiersza z opisem grupy. :

SELECT  a as kod, b as wartosc, [Descr] as opis_grupy FROM TableA

UNION ALL SELECT  left(a,3)&"-Total" As kod, sum(b) As wartosc, "" as opis_grupy  FROM TableA

GROUP BY left(a,3)

UNION ALL SELECT a AS kod, "" AS wartosc, [Descr] AS opis_grupy FROM TableB

WHERE a IN (SELECT  left(TableA.a,3)FROM TableA)

UNION ALL SELECT  "-Grand Total-" As kod, sum(b) As wartosc, "" as opis_grupy  FROM TableA
ORDER BY kod;

Realizacja w VBA:

Public Sub SporzadzOferte()
Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook As String
Dim strSQL As String
Dim i As Integer

'Deal with input data range so that it refers to a Table and not to a Sheet!
'It will allow writing notes and puting a header above the table


Dim rngTableA As String

    rngTableA = Replace(Sheets("TableA").Range("TableA[#All]").Address, "$", "")
    rngTableA = "[TableA$" & rngTableA & "]"
 
'Debug.Print rngTableA


'--------------------

Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
 
  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName

'Open connection to the workbook
   Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties='Excel 12.0 Xml;HDR=YES;IMEX=1'"

'Build SQL Statement

    strSQL = "SELECT  a as kod, b as wartosc, [Descr] as opis_grupy FROM " & rngTableA & " " & _
"UNION ALL SELECT  left(a,3)&'-Total' As kod, sum(b) As wartosc, '' as opis_grupy FROM " & rngTableA & " " & _
"WHERE a IS NOT NULL " & _
"GROUP BY left(a,3)" & _
"UNION ALL SELECT a AS kod, '' AS wartosc, [Descr] AS opis_grupy FROM [TableB$]" & _
"WHERE a IN (SELECT  left(" & rngTableA & ".a,3) FROM " & rngTableA & ") " & _
"UNION ALL SELECT  'zzz-Grand Total-' As kod, sum(b) As wartosc, '' as opis_grupy  FROM " & rngTableA & " " & _
"ORDER BY kod"
 
    

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

    
'Place the Recordset onto SheetX
   With Sheets("Oferta")
    .Activate
    .ListObjects("Table3").DataBodyRange.Rows.Delete
    .Range("A5").CopyFromRecordset Myrecordset
    
 
    'Add column heading names
    For i = 1 To Myrecordset.Fields.Count
    .Cells(4, i).Value = Myrecordset.Fields(i - 1).Name
    Next i
   
   End With
   
   
   
   Set Myrecordset = Nothing
   Myconnection.Close
   
   Call BoldAndInsertEmptyRow
   
        
End Sub

Teraz jeszcze trzeba sformatować otrzymaną tabelę:

Option Explicit


Sub BoldAndInsertEmptyRow()

    Dim oListObj As ListObject
    Dim RowCnt As Long
    Dim r As Long

    Set oListObj = Worksheets("Oferta").ListObjects("Table3") 'change the sheet and table names accordingly
    
    Application.ScreenUpdating = False
   
' Solve the problem with values not showing up in proper (currency) format but in text format.
    Dim Cell As Range
    
    For Each Cell In oListObj.ListColumns("wartosc").DataBodyRange
    
           With Cell
               If .Value <> "" Then
                   .NumberFormat = "#,##0.00 $"
                   .Value = CCur(Val(.Value))
               End If
           End With
    
    Next Cell

   
    '==========
'Format rows with totals: add empty row above, frame, delete zzz grom Grand Total.
    
    RowCnt = oListObj.ListRows.Count
    
    For r = RowCnt To 1 Step -1
        With oListObj.ListRows(r).Range
            
            'If contains "TOTAL" - bold ent.row and add empty row below.
            
            If InStr(UCase((.Cells(1, 1).Value)), "TOTAL") > 0 Then
                .Font.Bold = True
                
                With .Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
                
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlDouble
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlThick
                End With

                If r < RowCnt Then
                    oListObj.ListRows.Add Position:=r + 1, alwaysinsert:=True
                End If
            End If
            
             ' format rows with description
            
            If .Cells(1, 2).Value = "" Then

                .Cells(1, 1).Font.Bold = True
                
                
                With .Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .ColorIndex = 0
                    .TintAndShade = 0
                    .Weight = xlMedium
                End With
            
            End If
            
            'remve zzz from Grand Total
            
            If .Cells(1, 1).Value = "zzz-Grand Total-" Then
                    .Cells(1, 1).Value = "Grand Total"
            End If
            
        End With
    Next r


Application.ScreenUpdating = True

End Sub

Przykładowy plik tutaj.

Ciekawe strony na ten temat:
http://stackoverflow.com/questions/1839214/add-a-summary-row-to-ms-access-query
http://stackoverflow.com/questions/7157764/roll-up-and-cube-operator-in-access-summary-queries
https://technet.microsoft.com/en-us/library/bb510427(v=sql.105).aspx
http://p2p.wrox.com/access-vba/24326-roll-up-cube-compute-aggregate-funct-access.html

Również ciekawe, o subqueries:
http://allenbrowne.com/subquery-01.html
http://allenbrowne.com/subquery-02.html
http://stackoverflow.com/questions/11646664/querying-two-tables-in-ms-access?rq=1

czwartek, 2 kwietnia 2015

Jak wygodnie edytować SQL...w VBA excela?

Może wyprowadzić treść łańcucha tekstowego na zewnątrz, by można go było edytować np. w Notepadzie++? Pogooglowałem.

Na przykład ciekawą propozycję znalazłem tutaj (autor Steve): http://stackoverflow.com/a/14916197/3480717
aby wczytywać string SQL z pliku tekstowego.

Quote:
// On initialization:
global strSQL
f = open("strSQL.sql")
strSQL = read_all(f)
close(f)

// To to the select:
DoCmd.RunSQL(strSQL)

... jak wciągnąć z pliku tekstowego do zmiennej string? Tutaj przykład: http://mrspreadsheets.com/1/post/2013/09/vba-code-snippet-22-read-entire-text-file-into-string-variable.html

A tutaj już bardzo użyteczny przykład: http://www.ozgrid.com/forum/showthread.php?t=173707

Jeśli plik tekstowy z kwerendą sql będzie już oddzielony od kodu VBA, będzie go można wygodnie edytować np. w Notepadzie++, korzystając z jego udogodnień jak np. kolorowanie składni.
albo http://www.codeproject.com/Articles/37769/MS-Access-Databases-Queries-Editor

Lookup: Przypisz krótkie nazwy długim używając słownika.

W danych, które otrzymałem, występują nazwy firm w różnych wariantach. Mogę być pewien, że przynajmniej jeden człon, może jeden wyraz, będzie identyfikował poszczególne firmy. Tworzę więc słowniczek takich skróconych nazw, które występują w mojej bazie. Jak je przypisać?

1. Przetestowałem w Accesie:
Table_A to moja baza danych
Table_B to mój słowniczek skróconych nazw, które występują w długich nazwach.

SELECT Table_A.Full_name, Table_B.Short_name, Table_B.ID_firmy
FROM Table_B RIGHT JOIN Table_A ON  Table_A.Full_name Like "*"+Table_B.Short_name+"*";

2. Przetestowałem również w Excelu różne rozwiązania i ostatecznie otrzymałem podpowiedź na forum Altkom Pana Krzysztofa Rutkowskiego:

Słowniczek

Excomers	1
Futuro	2
Polexpo	3

Baza zewnętrzna	Tutaj działa formuła

Przedsiębiorstwo Handlu Polexpo.	3
Dystrybutor - FUTURO PUH	2
Excomers przedsiębiorstwo handlu	1
Przeds. Futuro Sp. z o.o.	2
Jan Kowalski Excomers.	1
polexpo	3
excomers	1

={INDEX($D$6:$D$8;MATCH(FALSE;ISERROR(SEARCH($C$6:$C$8;C12));0))}
Uwaga, formuła tablicowa Ctrl+Shift+Enter
Uwaga, słowniczek należy posortować malejąco.

gdzie C12 to nazwa długa w Bazie
zaś w słowniczku szukamy: $C$6:$C$8 to nazwa krótka, w zakresie $D$6:$D$8 - ID firmy,. Jeśli zaś do przyporządkowania nie ma zbyt wielu krótszych nazw, w Accesie można użyć switch'a a w MS SQLu IN.

SELECT 
 switch(
   Table1.Nazwa LIKE  "*Vicryl PLUS*", "Vicryl PLUS",
   Table1.Nazwa LIKE  "*Vicryl*" And  Table1.Nazwa Not LIKE "*PLUS*" , "Vicryl",
   Table1.Nazwa LIKE  "*Monocryl PLUS*", "Monocryl PLUS",
   true,"N/A"
   
 ),

Table1.Nazwa, Table1.Wartość
FROM Table1

Nauka LINQ bez SQL servera? Linq to Excel!

Polecam przykład użycia kwerendy napisanej w Linq przy użyciu biblioteki C# Linq to Excel (autor Paul Yoder): https://vimeo.com/7689508 Link zamieszczony w dyskusji Read Excel using LINQ (Stackoverflow).

Użycie razem bibliotek Linq to Excel i ExcelDNA może być niezmiernie przydatne np może służyć do. tworzenia makr, które na danych Excela będą wykonywać operacje bazodanowe.
Przykłady użycia Linq:http://codesamplez.com/database/linq-to-sql-c-sharp-tutorial https://code.msdn.microsoft.com/101-LINQ-Samples-3fb9811b

środa, 1 kwietnia 2015

Syntax highlighter na stronach do wypróbowania.

Blogger może łatwo korzystać z kolorowania kodu. Opis tutaj, do wypróbowania w moim blogu wkrótce: http://stackoverflow.com/questions/10335463/how-to-setup-syntax-highlighter-on-blogger
(albo https://code.google.com/p/google-code-prettify/)

SQL w Excelu Cz.2: zależne listy rozwijane, walidacja (dependent lists)

W jednej z zakładek (albo w zewnętrznym pliku) posiadamy bazę produktów. W pierwszej kolumnie posiadamy kategorię nadrzędną (major), w drugiej kategorię podrzędną (minor) a w trzeciej kody konkretnych produktów, pozostałe zaś zawierają opisy, ceny, etc.

Chcielibyśmy aby w kolejnej zakładce (np. faktura proforma, oferta) wybór w pierwszej zakładce z listy rozwijanej (walidacja w Excelu) zawierał posortowaną listę występujących kategorii nadrzędnych. Wybór kategorii nadrzędnej ma spowodować rozwinięcie w sąsiedniej komórce listy kategorii podrzędnych tylko tych, które należą do kat. nadrzędnej. Z kolei wybór kategorii podrzędnej ma spowodować rozwinięcie w sąsiedniej komórce kodów. Tylko tych kodów, które należą do wybranej kat. podrzędnej. Wybór kodu ma wypełnić pozostałe sąsiadujące komórki informacją o cenie, opisem etc. ...

Konieczne jest zainstalowanie Access Runtime i dołączenie referencji do Microsoft ActiveX Data (łatwe i za darmo, patrz cz.1)

Oto propozycja rozwiązania w VBA:

W kodzie aktywującym (trigger) makra związane z wykonywanymi operacjami na arkuszu należy wprowadzić następujące makro (należy kliknąć prawym przyciskiem myszy na zakładkę arkusza z naszą fakturą proformą i wybrać z wyświetlonego menu "View Code"):

Private Sub Worksheet_Change(ByVal Target As Range)
    
    If Not Intersect(Target, Me.Range("Table1[Major]")) Is Nothing Then
            DependentLists1
    
    ElseIf Not Intersect(Target, Me.Range("Table1[Minor]")) Is Nothing Then
            DependentLists2
    ElseIf Not Intersect(Target, Me.Range("Table1[Code]")) Is Nothing Then
            DependentLists3
    Else
        Exit Sub
         
    End If

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Me.Range("Table1[Major]")) Is Nothing Then
            DependentLists0
    ElseIf Not Intersect(Target, Me.Range("Table1[Minor]")) Is Nothing Then
            GoLeftOnEmpty
    ElseIf Not Intersect(Target, Me.Range("Table1[Code]")) Is Nothing Then
            GoLeftOnEmpty
        
    End If
    
End Sub




Sub GoLeftOnEmpty()

 

 'If empty cell, go back higher up.
                    If ActiveCell.Offset(0, -1).Value = "" And ActiveCell.ListObject.ListColumns.Count <> 1 Then
                        Cells(ActiveCell.Row, Range("Table1[Major]").Column).Activate
                        Exit Sub
                    End If
End Sub

A teraz posłużymy się schematem z Cz1. Bazę produktów będziemy odpytywać prostymi zapytaniami SQL i zwracać wynik do listy walidacyjnej Excela. W nowym module kodu VBA należy wprowadzić dla listy rozwijanej w pierwszej kolumnie:

Sub DependentLists0()

On Error Resume Next


Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook, strSQL, DataStr As String

Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
Application.ScreenUpdating = False


  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName

'Open connection to the workbook
    Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties=Excel 8.0;" & _
                      "Persist Security Info=False"
                      

'edytuj
 
    strSQL = "SELECT DISTINCT [MajorName] " & _
             "FROM [Data$]  " & _
             "ORDER BY 1 ASC"
  

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

'Load Recordset to string variable

DataStr = Myrecordset.GetString(, , , ",", "") 'Options: StringFormat np. adClipString, NumRows, ColumnDelimiter, RowDelimiter, NullExpr

'Change validation for one cell left
 
 
With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:=DataStr
        .IgnoreBlank = True
        .InCellDropdown = True
        .InputTitle = ""
        .ErrorTitle = ""
        .InputMessage = ""
        .ErrorMessage = ""
        .ShowInput = True
        .ShowError = True
    End With
Application.SendKeys ("%{DOWN}")
   
   
'Remove Garbage
   Set Myrecordset = Nothing
   Myconnection.Close
   Application.ScreenUpdating = True


        
End Sub

Zaś w nowym module kodu VBA wkleić kod dla listy rozwijanej w drugiej kolumnie:

Sub DependentLists1()

On Error Resume Next


Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook, strSQL, DataStr As String

Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
Application.ScreenUpdating = False
  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName

'Open connection to the workbook



   Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties=Excel 8.0;" & _
                      "Persist Security Info=False"
                      

'Build SQL Statement
        
    strSQL = "SELECT DISTINCT [MinorName] " & _
             "FROM [Data$]  " & _
             "WHERE [MajorName] =  '" & ActiveCell.Value & "'  " & _
             "ORDER BY 1 ASC"
  

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

'Load Recordset to string variable

DataStr = Myrecordset.GetString(, , , ",", "") 'Options: StringFormat np. adClipString, NumRows, ColumnDelimiter, RowDelimiter, NullExpr

'Change validation for one cell left
 
ActiveCell.Offset(0, 1).Select

 
 With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=DataStr
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True

End With

Application.SendKeys ("%{DOWN}")
   
   
'Remove Garbage
   Set Myrecordset = Nothing
   Myconnection.Close

Application.ScreenUpdating = True
        
End Sub

Dla list rozwijanych w trzeciej kolumnie:

Sub DependentLists2()

On Error Resume Next


Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook, strSQL, DataStr As String

Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
Application.ScreenUpdating = False
  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName

'Open connection to the workbook

   Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties=Excel 8.0;" & _
                      "Persist Security Info=False"
                      


'Build SQL Statement
        
    strSQL = "SELECT DISTINCT [Code] " & _
             "FROM [Data$]  " & _
             "WHERE [MinorName] =  '" & ActiveCell.Value & "'  " & _
             "ORDER BY 1 ASC"
  

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

'Load Recordset to string variable

DataStr = Myrecordset.GetString(, , , ",", "") 'Options: StringFormat np. adClipString, NumRows, ColumnDelimiter, RowDelimiter, NullExpr

'Change validation for one cell left
 
ActiveCell.Offset(0, 1).Select
 
 With Selection.Validation
            .Delete
            .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
            xlBetween, Formula1:=DataStr
            .IgnoreBlank = True
            .InCellDropdown = True
            .InputTitle = ""
            .ErrorTitle = ""
            .InputMessage = ""
            .ErrorMessage = ""
            .ShowInput = True
            .ShowError = True
  End With

Application.SendKeys ("%{DOWN}")
   
   
'Remove Garbage
   Set Myrecordset = Nothing
   Myconnection.Close

Application.ScreenUpdating = True
        
End Sub

Dla wypełnienia pozostałych kolumn poslużymy się zaś takim kodem:

Sub DependentLists3()

Dim Myconnection As Connection
Dim Myrecordset As Recordset
Dim Myworkbook, strSQL, DataStr1, DataStr2 As String
Dim DataVal1 As Single


Set Myconnection = New Connection
Set Myrecordset = New Recordset
  
Application.ScreenUpdating = False
  
  
  
'Identify the workbook you are referencing
    Myworkbook = Application.ThisWorkbook.FullName
    
    

'Open connection to the workbook

   Myconnection.Open "Provider=Microsoft.ACE.OLEDB.12.0;" & _
                      "Data Source=" & Myworkbook & ";" & _
                      "Extended Properties=Excel 8.0;" & _
                      "Persist Security Info=False"
                      


'Build SQL Statement
        
    strSQL = "SELECT DISTINCT [Desc_1], [Desc_2],[Value]" & _
             "FROM [Data$]  " & _
             "WHERE [Code] =  '" & ActiveCell.Value & "'  " & _
             "ORDER BY 1 ASC"
  

'Load the Query into a Recordset
    Myrecordset.Open strSQL, Myconnection, adOpenStatic

'Load Recordset to variables

DataStr1 = IIf(IsNull(Myrecordset.Fields("Desc_1").Value), "n/a", Myrecordset.Fields("Desc_1").Value)
DataStr2 = IIf(IsNull(Myrecordset.Fields("Desc_2").Value), "n/a", Myrecordset.Fields("Desc_2").Value)
DataVal1 = IIf(IsNull(Myrecordset.Fields("Value").Value), "n/a", Myrecordset.Fields("Value").Value)

'Change validation for one cell left
 
ActiveCell.Offset(0, 1).Value = DataStr1
ActiveCell.Offset(0, 2).Value = DataStr2
ActiveCell.Offset(0, 3).Value = DataVal1
   
'Remove Garbage
   Set Myrecordset = Nothing
   Myconnection.Close

Application.ScreenUpdating = True
        
End Sub

Przykładowy plik tutaj.