viernes, 15 de abril de 2022

Excel selection

 https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/

Sub audiencia()

'

' audiencia Macro

'

' Acceso directo: CTRL+w

'

'https://blog.excelforo.com/2014/05/vba-diferencias-entre-usedrange-y.html

'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/

'https://www.excel-avanzado.com/7687/compacion-entre-range-y-cells.html

'http://elsabiodeexcel.blogspot.com/2018/05/hojas-de-trabajo-worksheets-vs-hojas-sheets-VBA.html

'https://excelchamps.com/vba/activate-workbook/



 'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/

 'MsgBox "You have highlighted cell " & Selection.Address

 

 'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/

 'Dim indCell As Range

 'For Each indCell In Selection

 '   MsgBox indCell.Address & " " & indCell.Value

 'Next indCell

 

 'https://www.mrexcel.com/board/threads/need-message-box-to-display-cell-or-range-of-cells-selected.303592/

 'MsgBox "Left column =" & vbTab & Selection.Column & vbCrLf & _

 '   "Columns selected =" & vbTab & Selection.Columns.Count & vbCrLf & _

 '   "Top row =" & vbTab & Selection.Row & vbCrLf & _

 '   "Rows selected = " & vbTab & Selection.Rows.Count

 

  

 Dim lC As Integer, nC As Integer, lR As Integer, nR As Integer

 lC = Selection.Column

 nC = Selection.Columns.Count

 lR = Selection.Row

 nR = Selection.Rows.Count

 

 'limpiar la hoja de destino

 Workbooks("audiencias_1.xlsm").Worksheets("Hoja2").Cells.Clear

 

 Range(Cells(lR, lC), Cells(lR + nR - 1, lC + nC - 1)).Copy Destination:=Workbooks("audiencias_1.xlsm").Sheets("Hoja2").Range("A1")

 

 Dim lRR As Integer, lCC As Integer

 lRR = 1

 lCC = 1

 'https://excelchamps.com/vba/activate-workbook/

 Workbooks("audiencias_1.xlsm").Activate

 Sheets("Hoja2").Activate

 Sheets("Hoja2").Range(Cells(lRR, lCC), Cells(lRR + nR - 1, lCC + nC - 1)).Select

 'Range("A1:J15").Select

 

    ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Clear

    ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range(Cells(lRR, lCC + 1), Cells(lRR + nR - 1, lCC + 1)), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    ActiveWorkbook.Worksheets("Hoja2").Sort.SortFields.Add Key:=Range(Cells(lRR, lCC + 2), Cells(lRR + nR - 1, lCC + 2)), _

        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("Hoja2").Sort

        .SetRange Range("A1:J15")

        .Header = xlGuess

        .MatchCase = False

        .Orientation = xlTopToBottom

        .SortMethod = xlPinYin

        .Apply

    End With

 

 'dividir

  Range(Cells(lRR, lCC + 9), Cells(lRR + nR - 1, lCC + 9)).Select

 Selection.TextToColumns Destination:=Range(Cells(lRR, lCC + 9), Cells(lRR, lCC + 9)), DataType:=xlDelimited, _

        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _

        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _

        :="_", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1)), _

        TrailingMinusNumbers:=True

        

 'interno

 Range(Cells(lRR, lCC + 9), Cells(lRR + nR - 1, lCC + 9)).Select

 Selection.Copy

 Range(Cells(lRR, lCC + 4), Cells(lRR, lCC + 4)).Select

 ActiveSheet.Paste

    

 'pasar temporalmente la columna de la corte solicitante

 Range(Cells(lRR, lCC + 5), Cells(lRR + nR - 1, lCC + 5)).Select

 Selection.Copy

 Range(Cells(lRR, lCC + 7), Cells(lRR, lCC + 7)).Select

 ActiveSheet.Paste

    

'colocar en la columna correcta la sala

Range(Cells(lRR, lCC + 6), Cells(lRR + nR - 1, lCC + 6)).Select

Selection.Copy

Range(Cells(lRR, lCC + 5), Cells(lRR, lCC + 5)).Select

ActiveSheet.Paste

    

'colocar en la columna correcta la corte solicitante

Range(Cells(lRR, lCC + 7), Cells(lRR + nR - 1, lCC + 7)).Select

Selection.Copy

Range(Cells(lRR, lCC + 6), Cells(lRR, lCC + 6)).Select

ActiveSheet.Paste


Range(Cells(lRR, lCC + 10), Cells(lRR + nR - 1, lCC + 10)).Select

Application.CutCopyMode = False

Selection.Copy

Range(Cells(lRR, lCC + 7), Cells(lRR, lCC + 7)).Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _

        :=False, Transpose:=False


'a mayusculas el texto

Range(Cells(lRR, lCC + 4), Cells(lRR + nR - 1, lCC + 7)).Select

Dim Rng As Range

For Each Rng In Selection.Cells

If Rng.HasFormula = False Then

Rng.Value = UCase(Rng.Value)

End If

Next Rng


'alinear a la derecha la fecha

Range(Cells(lRR, lCC + 2), Cells(lRR + nR - 1, lCC + 3)).Select

Application.CutCopyMode = False

With Selection

        .HorizontalAlignment = xlRight

        .VerticalAlignment = xlBottom

        .WrapText = False

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = False

End With


Dim i As Integer

i = 1

For Each cell In Range(Cells(lRR, lCC), Cells(lRR + nR - 1, lCC))

  cell.Value = i

  i = i + 1

Next cell


Columns("I:AGX").Select

Range("J1").Activate

Selection.Delete Shift:=xlToLeft


End Sub

No hay comentarios:

Publicar un comentario