Excel Forum

Excel Forum (http://www.excel.web.tr/index.php)
-   Windows-Word-PowerPoint.... (http://www.excel.web.tr/forumdisplay.php?f=51)
-   -   Word Dosyasında Kelimeleri karıştırmak (http://www.excel.web.tr/showthread.php?t=165240)

dogusvealp 05-07-2017 12:29

Word Dosyasında Kelimeleri karıştırmak
 
KADRAJ
KADRAN
KADRAT
KADRİL
.
.
.
STATİK
STATOR
STEPNE
STERİL
STEROL

Şeklinde alfabetik sırayla devam eden bine yakın kelime var ve ben bunların sırasını karıştırmak istiyorum.Mesela Statatik, Kadran, Stator, Kadril vs... gibi.
Böyle bir şey yapmam mümkün mü acaba?

netcini 05-07-2017 14:10

Şöyle yapabilirsiniz.

Kelimeleri excelde A sütünuna yapıştırın.

B sütünuna =RASTGELEARADA(1;2000) formülünü yazın
Kelimelerin bitişine kadar, bu formülü aşağıya doğru kopyalayın.

Sonra B sütunu komple seçip kopyalayın. Ve değerleri yapıştırın.

A ve B sütünunu seçerek B sütünuna göre sıralama yapın. Kelimeleriniz karışmış olacak.

A sütünündaki kelimeleri seçip kopyalaıp, Word'a metin yapıştır ile yapıştırırsınız. :)

asri 05-07-2017 15:08

Alternatif makrolu çözüm;

Kelimelerin A kolonunda bulunduğu varsayılmıştır.
B kolonu geçici kullanım için silinecektir.
Kelime sayısı değişken olabilir.

Kod:

Sub karistir()
  Application.ScreenUpdating = False
  Application.DisplayAlerts = False
 
  'Sıralama için sayı üret
  sonsatir = Cells(Rows.Count, "A").End(3).Row
  ustsayi = sonsatir
  altsayi = 1
  Range("B1:B" & sonsatir).Clear
  For i = 1 To sonsatir
 
basla:
    DoEvents
    Randomize
    sayi = Int((ustsayi - altsayi + 1) * Rnd + altsayi)
    If WorksheetFunction.CountIf(Range("B1:B" & sonsatir), sayi) > 0 Then
        GoTo basla
    End If
    If sayi = altsayi Then altsayi = sayi + 1
    If sayi = ustsayi Then ustsayi = sayi - 1
   
    Cells(i, "B").Value = sayi
  Next i
 
  'Yeni sıralamayı yap
    sayfaadi = ActiveSheet.Name
    Columns("A:B").Select
    Range("B1").Activate
    ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Clear
    ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Add Key:=Range("B1:B" & sonsatir _
        ), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets(sayfaadi).Sort
        .SetRange Range("A1:B" & sonsatir)
        .Header = xlGuess
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    Columns("B:B").Select
    Selection.ClearContents
    Range("B1").Select
   
  Application.ScreenUpdating = True
  Application.DisplayAlerts = True
  MsgBox ("Karıştırma işlemi tamamlandı.")
End Sub


dogusvealp 05-07-2017 16:43

Çok teşekkür ederim netcini ve asri hocalarım sayenizde sorunumu hallettim. İyi günler ve iyi çalışmalar dilerim sizlere.


Saat 16:05

Powered by vBulletin Version 3.7.2
Copyright ©2000 - 2017, Jelsoft Enterprises Ltd.