comment obtenir la plus petite (min) et la plus grande (max) valeur dans une colonne dans une feuille spécifique en utilisant VBA

Question

J'ai un problème avec mon code, il ne peut pas afficher la plus petite et la plus grande valeur dans la colonne A. Je ne sais pas savoir où est le code manquant ou faux ...

mon programme ouvrir le fichier txt et entrer les données à la feuille Excel. par exemple les données dans la colonne A est:

0.23 
0.19 
0.19 
0.13 
0.15 
0.18 
0.19 
0.25 
0.25 
0.22 
0.13 

et je tape mon code dans VBA:

Private Sub CommandButton1_Click() 

Dim vMin, vMax 
Dim mg As Range 
Dim NOR, lastrow, currentrow As Long 

filetoopen = Application.GetOpenFilename("Text File (*.txt),*.txt", , "Select", , False) 

If VarType(filetoopen) = vbBoolean Then 
    Exit Sub 
End If 

Workbooks.OpenText filetoopen, Origin _ 
    :=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _ 
    , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _ 
    False, Space:=False, other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _ 
    , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _ 
    Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), _ 
    TrailingMinusNumbers:=True 

'get number of rows (row with value inside)------------- 
With ActiveSheet 
    NOR = .Cells(Rows.Count, "A").End(xlUp).Row 
End With 

'GET SMALLEST & LARGEST VALUE FROM COLUMN A========== 
With ActiveSheet 
    lastrow = NOR 

    For currentrow = 2 To lastrow 
     Set mg = ThisWorkbook.Sheets(1).Rows(currentrow) 

     'if row no data then no read------------------------ 
     If WorksheetFunction.CountA(mg) = 0 Then 

     Else 
      vMin = Application.WorksheetFunction.Min(Columns("A")) 
      vMax = Application.WorksheetFunction.Max(Columns("A")) 
     End If 
    Next currentrow 

End With 

MsgBox "Minimum = " & vMin & ", " & "Maximum = " & vMax, vbInformation 
MsgBox "last row A is = " & NOR 

End Sub 

Si je lance ce code, le MessageBox ne peut pas afficher la valeur minimale (la plus petite) et Maximum (plus grand) valeur dans la colonne A.

J'espère que vous pouvez m'aider à résoudre le problème.

AAF

Answer 1

J'ai essayé votre code ... et deux pense:

1. L'application d'une fonction `colonnes ("A")» implique toute la colonne si il n'y a pas besoin Itérer avec pour.

2. Dans mon cas, peut-être pas utilisé le vôtre chiffres importé dot un séparateur décimal et mon système utilise la virgule comme séparateur décimal ainsi importés numéros ont été importés sous forme de texte et ni'Max' ni'Min' travaillé jusqu'à ce que les points modifiés à virgules .

Ainsi, le code de travail pourrait être:

Private Sub CommandButton1_Click() 

Dim vMin, vMax 

Dim mg As Range 

Dim NOR, lastrow, currentrow As Long 

filetoopen = Application.GetOpenFilename("Text File (*.txt),*.txt", , "Select", , False) 

     If VarType(filetoopen) = vbBoolean Then 
     Exit Sub 
     End If 
     Workbooks.OpenText filetoopen, Origin _ 
     :=437, StartRow:=1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote _ 
     , ConsecutiveDelimiter:=False, Tab:=True, Semicolon:=False, Comma:= _ 
     False, Space:=False, Other:=False, FieldInfo:=Array(Array(1, 1), Array(2, 1) _ 
     , Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), _ 
     Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1)), _ 
     TrailingMinusNumbers:=True 

'get number of rows (row with value inside)------------- 

    With ActiveSheet 

    NOR = .Cells(Rows.Count, "A").End(xlUp).Row 

    End With 

'GET SMALLEST & LARGEST VALUE FROM COLUMN A========== 

With ActiveSheet 

    lastrow = NOR 

    'For currentrow = 2 To lastrow 

    'Set mg = ThisWorkbook.Sheets(1).Rows(currentrow) 

    'if row no data then no read------------------------ 

    'If WorksheetFunction.CountA(mg) = 0 Then 

    'Else 

     vMin = Application.WorksheetFunction.Min(Columns("A")) 

     vMax = Application.WorksheetFunction.Max(Columns("A")) 

    'End If 

    'Next currentrow 

End With 

MsgBox "Minimum = " & vMin & ", " & "Maximum = " & vMax, vbInformation 

MsgBox "last row A is = " & NOR 

End Sub 

Et les résultats:

Hope it helps!

Answer 2

Voici une approche alternative qui utilisera ADO pour lire le fichier directement, au lieu de devoir l'importer dans Excel, ce qui devrait être plus rapide. L'option est moins de code, et devrait fonctionner très rapidement, même pour les grands ensembles de données.

code:

Public Sub ShowMinAndMax() 
    Dim objConnection As Object: Set objConnection = CreateObject("ADODB.Connection") 
    Dim objRecordset As Object: Set objRecordset = CreateObject("ADODB.Recordset") 
    Dim FolderPath As String: FolderPath = "C:\SomeFolderHere\" ' The folderpath to the file you want to read 

    objConnection.Open "Provider=Microsoft.Ace.OLEDB.12.0;" & _ 
         "Data Source=" & FolderPath & ";" & _ 
         "Extended Properties=""text;HDR=No;FMT=TabDelimited""" 

    'Get the minimum and maximum value, you also need to 
    'change the fileName, currently my File is Named Example.Txt. 
    'You need to update that in the SQL statement 
    objRecordset.Open "SELECT Min(F1) as MinVal, Max(F1) as MaxVal FROM Example.txt", objConnection, 3 

    MsgBox ("The minimum value is: " & objRecordset.Fields("MinVal") & vbCrLf & _ 
      "The maximum value is: " & objRecordset.Fields("MaxVal")) 

    'Clean Up 
    If objRecordset.State = 1 Then objRecordset.Close 
    objConnection.Close 
    Set objConnection = Nothing 
    Set objRecordset = Nothing 
End Sub