Google शीट्स हर किसी के लिए नहीं हो सकती है , इसी सोच में , यह मैक्रो सभी के लिए नहीं हो सकता है लेकिन यह किसी के लिए हो सकता है ।
यह चयनित सीमा के माध्यम से चलता है और ट्रंक किए गए पाठ के साथ अतिप्रवाह कोशिकाओं की जगह लेता है।
झंडे निर्धारित करता है अगर:
आपत्तिजनक पाठ को नए वर्कशीट में उसी रिश्तेदार पते पर कॉपी किया जाता है या यदि उसे छोड़ दिया जाता है।
काटे गए पाठ को हार्ड कोडित किया गया है या कार्यपत्रक सूत्र के माध्यम से जोड़ा गया है =LEFT()
काटे गए पाठ को नई शीट में पूर्ण स्ट्रिंग पर हाइपरलिंक किया गया है।
डिफ़ॉल्ट डेटा को बनाए रखने और दोनों लिंक का उपयोग करने के लिए है।
Option Explicit
Sub LinkTruncatedCells()
Dim rng As Range: Set rng = Selection
Dim preserveValues As Boolean: preserveValues = True
Dim linkAsFormula As Boolean: linkAsFormula = True
Dim linkAsHyperlink As Boolean: linkAsHyperlink = True
Dim w As Single
Dim c As Range
Dim r As Range
Dim t As Long
Dim l As Long
Dim s As String
Dim ws As Worksheet
Dim ns As Worksheet
Application.ScreenUpdating = False
Set ws = rng.Parent
For Each c In rng.Columns
w = c.ColumnWidth
t = 0
l = 0
For Each r In c.Rows
If Len(r) > l Then
s = r
If CBool(l) Then r = Left(s, l)
Do
r.Columns.AutoFit
If r.ColumnWidth > w And Len(s) > t Then
t = t + 1
r = Left(s, Len(s) - t)
l = Len(r)
End If
Loop Until t = Len(s) Or r.ColumnWidth <= w
r.ColumnWidth = w
If r <> s And preserveValues Then
If ns Is Nothing Then
Set ns = ws.Parent.Worksheets.Add(after:=ws)
End If
ns.Range(r.Address) = s
If linkAsFormula Then r.Formula = "=LEFT(" & ns.Name & "!" & r.Address & "," & l & ")"
If linkAsHyperlink Then ws.Hyperlinks.Add Anchor:=r, Address:="", SubAddress:= _
ns.Range(r.Address).Address(external:=True)
End If
End If
Next r
Next c
ws.Activate
Application.ScreenUpdating = True
End Sub
अंतिम नोट: मैंने इसे निजी परियोजनाओं के लिए उपयोग किया है और इसे विश्वसनीय पाया है लेकिन कृपया किसी भी अपरिचित मैक्रो को आज़माने से पहले अपने काम को बचाएं और बैकअप लें ।