Yang terhormat para anggota dan guru besar excel.
Saya dapat code macro seperti yang saya lampirkan. Kata yang buat, kode
tersebut untuk membuat range dinamis.
Yang ingin saya tanyakan adalah
1. Bagaimana cara memasukkan code tersebut ke dalam excel. Tolong dijelaskan
step by
step.
2. Setelah masuk, cara penggunaannya gimana?
Terima kasih berat.
Sub MakeDynRanges()
' shg 2011-06
' Adds dynamic ranges using the names in the top row of the selection
Dim r As Range
Dim cell As Range
If Not TypeOf Selection Is Range Then
MsgBox Prompt:="Select a range and try again.", _
Title:="Oops!"
Exit Sub
End If
ActiveWorkbook.Names.Add Name:="conBig", RefersTo:=9.99999999999999E+307
ActiveWorkbook.Names.Add Name:="conZzz", RefersTo:="=rept(""z"", 255)"
Set r = Selection
For Each cell In Intersect(r.Rows(1).EntireRow, r.EntireColumn).Cells
If Len(cell.Text) Then
MakeDynRange cell, VarType(cell.Offset(1).Value2)
End If
Next cell
End Sub
Function MakeDynRange(cell As Range, iType As VbVarType) As Boolean
' shg 2011-06
Dim sName As String
Dim sAdrCel As String
Dim sAdrCol As String
With cell.Worksheet
sName = Replace(Replace(cell.Text, " ", ""), Chr(160), "")
sAdrCel = cell.Address
sAdrCol = cell.EntireColumn.Address
If IsValidRangeName(sName) Then
Select Case iType
Case vbDouble
.Names.Add _
Name:=sName, _
RefersTo:="=index(" & sAdrCol & ", row(" & sAdrCel
& ") + 1):" & _
"index(" & sAdrCol & ", match(conBig, " &
sAdrCol & "))"
MakeDynRange = True
Case vbString
.Names.Add _
Name:=sName, _
RefersTo:="=index(" & sAdrCol & ", row(" & sAdrCel
& ") + 1):" & _
"index(" & sAdrCol & ", match(conZzz, " &
sAdrCol & "))"
MakeDynRange = True
Case Else
Select Case InputBox(Prompt:="Data below cell " &
cell.Address & " will be: " & vbLf & vbLf & _
"1. Numbers" & vbLf & _
"2. Text", _
Title:="Dynamic Column Ranges")
Case "1"
MakeDynRange = MakeDynRange(cell, vbDouble)
Case "2"
MakeDynRange = MakeDynRange(cell, vbString)
Case Else
Exit Function
End Select
End Select
Else
MsgBox Prompt:="""" & sName & """ in " & _
cell.Address(False, False) & _
" is not a valid name.", _
Title:="Oops"
End If
End With
End Function
Function IsValidRangeName(sInp As String) As Boolean
' shg 2011-06
Dim sTest As String
With CreateObject("VBScript.RegExp")
.IgnoreCase = True
.Pattern = "^[A-Z_][\w]{0,254}$"
If Not .test(sInp) Then Exit Function
End With
' verify that the name doesn't look like an A1 or R1C1 address
On Error Resume Next
With Application
sTest = LCase(.ConvertFormula(sInp, xlA1, xlR1C1, True))
If Err.Number = 0 Then
If sTest <> LCase(sInp) Then Exit Function
Else
Err.Clear
End If
sTest = LCase(.ConvertFormula(sInp, xlR1C1, xlA1, True))
If Err.Number = 0 Then
If sTest <> LCase(sInp) Then Exit Function
Else
Err.Clear
End If
End With
IsValidRangeName = True
End Function
